Saltar al contenido principal

¿Cómo guardar una hoja de trabajo como archivo PDF y enviarla por correo electrónico como archivo adjunto a través de Outlook?

En algunos casos, es posible que deba enviar una hoja de trabajo como archivo PDF a través de Outlook. Por lo general, debe guardar manualmente la hoja de trabajo como un archivo PDF, luego crear un nuevo correo electrónico con este archivo PDF como archivo adjunto en su Outlook y finalmente enviarlo. Lleva mucho tiempo lograrlo manualmente paso a paso. En este artículo, le mostraremos cómo guardar rápidamente una hoja de trabajo como un archivo PDF y enviarla automáticamente como un archivo adjunto a través de Outlook en Excel.

Guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto con código VBA


Guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto con código VBA

Puede ejecutar el siguiente código VBA para guardar automáticamente la hoja de trabajo activa como un archivo PDF y luego enviarla por correo electrónico como un archivo adjunto a través de Outlook. Haz lo siguiente.

1. Abra la hoja de trabajo que guardará como PDF y envíela, luego presione otro + F11 teclas simultáneamente para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En el Microsoft Visual Basic para aplicaciones ventana, haga clic recuadro > Módulo. Luego copie y pegue el siguiente código VBA en el Código ventana. Ver captura de pantalla:

Código VBA: guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. presione el F5 clave para ejecutar el código. En el Explorar cuadro de diálogo, seleccione una carpeta para guardar este archivo PDF y luego haga clic en el OK del botón.

Notas:

1. Ahora la hoja de trabajo activa se guarda como archivo PDF. Y el archivo PDF se nombra con el nombre de la hoja de trabajo.
2. Si la hoja de trabajo activa está en blanco, aparecerá un cuadro de diálogo como la siguiente captura de pantalla que se muestra después de hacer clic en el OK del botón.

4. Ahora se crea un nuevo correo electrónico de Outlook y puede ver que el archivo PDF aparece como un archivo adjunto en el archivo Adjunto. Ver captura de pantalla:

5. Redacte este correo electrónico y envíelo.
6. Este código solo está disponible cuando usa Outlook como su programa de correo.

Guarde fácilmente una hoja de trabajo o varias hojas de trabajo como archivos PDF separados a la vez:

La Libro de trabajo dividido utilidad de Kutools for Excel puede ayudarlo a guardar fácilmente una hoja de trabajo o varias hojas de trabajo como archivos PDF separados a la vez, como se muestra en la siguiente demostración. ¡Descárgalo y pruébalo ahora! (Tour gratuito de 30 días)


Artículos relacionados:

Las mejores herramientas de productividad de oficina

🤖 Asistente de IA de Kutools: Revolucionar el análisis de datos basado en: Ejecución inteligente   |  Generar codigo  |  Crear fórmulas personalizadas  |  Analizar datos y generar gráficos  |  Invocar funciones de Kutools...
Características populares: Buscar, resaltar o identificar duplicados   |  Eliminar filas en blanco   |  Combine columnas o celdas sin perder datos   |   Ronda sin fórmula ...
Super búsqueda: Búsqueda virtual de criterios múltiples    Búsqueda V de valores múltiples  |   VLookup en varias hojas   |   Búsqueda difusa ....
Lista desplegable avanzada: Crear rápidamente una lista desplegable   |  Lista desplegable dependiente   |  Lista desplegable de selección múltiple ....
Administrador de columnas: Agregar un número específico de columnas  |  Mover columnas  |  Toggle Estado de visibilidad de columnas ocultas  |  Comparar rangos y columnas ...
Características destacadas: Enfoque de cuadrícula   |  Vista de diseño   |   Gran barra de fórmulas    Administrador de hojas y libros de trabajo   |  Biblioteca de Recursos (Texto automático)   |  Selector de fechas   |  Combinar hojas de trabajo   |  Cifrar/descifrar celdas    Enviar correos electrónicos por lista   |  Súper filtro   |   Filtro especial (filtro negrita/cursiva/tachado...) ...
Los 15 mejores conjuntos de herramientas12 Texto Herramientas (Añadir texto, Quitar caracteres, ...)   |   50+ Tabla Tipos (Diagrama de Gantt, ...)   |   40+ Práctico Fórmulas (Calcular la edad según el cumpleaños, ...)   |   19 Inserción Herramientas (Insertar código QR, Insertar imagen desde la ruta, ...)   |   12 Conversión Herramientas (Números a palabras, Conversión de Moneda, ...)   |   7 Fusionar y dividir Herramientas (Filas combinadas avanzadas, Células partidas, ...)   |   ... y más

Mejore sus habilidades de Excel con Kutools for Excel y experimente la eficiencia como nunca antes. Kutools for Excel ofrece más de 300 funciones avanzadas para aumentar la productividad y ahorrar tiempo.  Haga clic aquí para obtener la función que más necesita...

Descripción


Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil

  • Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
  • Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
  • ¡Aumenta su productividad en un 50% y reduce cientos de clics del mouse todos los días!
Comments (67)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hi guys,
A huge thanks for the code. How can this be amended to use new version of Outlook ?
This comment was minimized by the moderator on the site
Hello, I am a total noob when doing this; so I apologize in advance.

My work has us email them our hours bi weekly, I am based in Arizona US. But I travel for work to Germany. My ADP time management app doesn't work well, given the time difference. So I email my hours, but it's annoying have to type it all every time. So I made a sheet in excel to help me out.
I am using the code posted above to attach pdf attachment to email. But I wanted to add the active sheet in the email body as well. How would I go about it using the same code posted in above. Basically I want to have a button to attach pdf of sheet and in the email body have a screenshot of the same sheet, But I also want my signature below.
I need both options in one button.
(I attached an image of what I mean about screenshot in email body )

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
End Sub
This comment was minimized by the moderator on the site
Hi Mayko,
The following VBA code can help you. After running the code, you need to select a folder to save the pdf file. Then, the pdf file will be inserted as an attachment to the email, and a screenshot of the contents of the currently active worksheet and the Outlook signature will be added to the body of the email.


Sub Saveaspdfandsend()
'Updated by Extendoffice 2023/10/19
    Dim xSht As Worksheet
    Dim xFileDlg As FileDialog
    Dim xFolder As String
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim defaultBodyText As String

    Set xSht = ActiveSheet
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

    If xFileDlg.Show = True Then
        xFolder = xFileDlg.SelectedItems(1)
    Else
        MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & _
               "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
        Exit Sub
    End If

    xFolder = xFolder & "\" & xSht.Name & ".pdf"

    'Check if file already exists
    If Len(Dir(xFolder)) > 0 Then
        Dim xYesorNo As Integer
        xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
        If xYesorNo <> vbYes Then
            MsgBox "If you don't overwrite the existing PDF, I can't continue." & vbCrLf & vbCrLf & _
                   "Press OK to exit this macro.", vbCritical, "Exiting Macro"
            Exit Sub
        End If
        On Error Resume Next
        Kill xFolder
        On Error GoTo 0
    End If

    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    
    ' Display the email first to ensure signature is loaded
    xEmailObj.Display

    ' Default body text
    defaultBodyText = "<br><br>Dear [Recipient Name],<br><br>Please find attached the requested document.<br><br>Best regards,<br>[Your Name]<br><br>"
    
    ' Update the body while preserving the original (which contains the signature)
    xEmailObj.HTMLBody = defaultBodyText & xEmailObj.HTMLBody

    'Copy the worksheet's content as a picture
    xSht.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    'Paste the copied picture to the mail body
    Dim xWordDoc As Object
    Set xWordDoc = xEmailObj.GetInspector.WordEditor
    xWordDoc.Range(0, 0).PasteAndFormat 16 ' 16 is wdChartPicture

    'Add the attachment
    xEmailObj.Attachments.Add xFolder
End Sub
This comment was minimized by the moderator on the site
I'm using the original post and loving it.
I would like to know how I would be able to set a permanent folder that it downloads the pdf into.
my folder is
G:\BFM\Supervisor\Shift Update Archive

Thankyou
This comment was minimized by the moderator on the site
Hi Zee,

The following VBA code can help. Please give it a try. Thank you.
Sub Saveaspdfandsend()
'Updated by Extendoffice 20230130
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet

xFolder = "G:\BFM\Supervisor\Shift Update Archive" + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub
This comment was minimized by the moderator on the site
Hi Crystal,

Is it possible to set the pdf name from a specific cell?

Thank you in advance!
This comment was minimized by the moderator on the site
Hi Cipri,
Suppose you want to name the pdf file with the value of A1.
Find the following line in the VBA code:
xFolder = xFolder + "\" + xSht.Name + ".pdf"

Then replace it with the line below.
xFolder = xFolder + "\" + Range("A1") + ".pdf"
This comment was minimized by the moderator on the site
Hi Crystal.

Is there any possibility to save the pdf automatically to a specific folder with the sheet name followed by date and time for example?

I have tried to run one of your codes but it gives me an error at this line

xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

Thank you!
This comment was minimized by the moderator on the site
Hi Cipri,
If you want to save the pdf automatically to a specific folder with the sheet name followed by date and time. The following VBA code can do you a favor.

Sub Saveaspdfandsend()
'Updated by Extendoffice 20220819
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + Format(Now, "dd-mmm-yy h-mm-ss") + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub
This comment was minimized by the moderator on the site
Hi,
Many thanks for the code, but can we save a range to PDF.

for example i would like to save a range from B2:Q40 to PDF only?
This comment was minimized by the moderator on the site
Hi,
The following VBA code can do you a favor. Please give it a try.
Sub Saveaspdfandsend()
'Updated by Extendoffice 20220819
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xWb As Workbook

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

'Set xUsedRng = xSht.UsedRange
Set xUsedRng = xSht.Range("B2:Q40")
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    Application.ScreenUpdating = False
    xUsedRng.Copy
    Set xWb = Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    Application.DisplayAlerts = False
    xWb.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub
This comment was minimized by the moderator on the site
Boa tarde,

Conteúdo muito bom mesmo.

É possível criar uma Macro que ao clicar no botão atribuído a essa macro ela envia a planilha automaticamente em PDF para um endereço de e-mail?

Desde já agradeço
Rated 5 out of 5
This comment was minimized by the moderator on the site
Hi Jurandir,
If you need a button to run the VBA code, please do as follows.
1. Click Develper > Insert > Button (Form Control), then draw a button in a worksheet.
2. After drawing the button, an Assign Macro dialog box pops up, click the New button.
3. Copy the VBA code except the first and last lines, and then paste it between the existing lines in the Code window.
4. Press the Alt + Q keys to close the Code window.
Then you can press the button to run the code.
This comment was minimized by the moderator on the site
hi this is working perfectly for me, Can you please help me to do the following along with this Code(1) to save, select the file name from a given cell in the worksheet(2) Automatically add an email address from a cell
This comment was minimized by the moderator on the site
Hi
Thanks for the code but I still having an issue emailing the doc in PDF straight after publishing. This is the current code that I have. I copied the "send email" code from this site.
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStrName As String

Dim x As Integer
Application.ScreenUpdating = False


' Set numrows = number of rows of data.
NumRows = Worksheets("DATA").Range("A2", Range("A2").End(xlDown)).Rows.Count
' Select cell a1.
Range("A2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
'Reference
Worksheets("Template").Cells(22, 5) = Worksheets("DATA").Cells(x + 1, 2)
'Invoice Number
Worksheets("Template").Cells(22, 7) = Worksheets("DATA").Cells(x + 1, 9)
'Description
Worksheets("Template").Cells(26, 1) = "HANDLING FEE:" & " " & Worksheets("DATA").Cells(x + 1, 6)
'Amounts
Worksheets("Template").Cells(26, 9) = Worksheets("DATA").Cells(x + 1, 4)

' Insert your code here.
' Selects cell down 1 row from active cell.
' ActiveCell.Offset(1, 0).Select
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Template")


'get active workbook folder, if saved
' On Error GoTo errHandler
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
Application.ScreenUpdating = True
strName = wsA.Range("L1").Value _
& " - " & wsA.Range("A2").Value _
& " - " & wsA.Range("A3").Value

'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile

'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
' MsgBox "PDF file has been created: " _
' & vbCrLf _
' & strPathFile

' Create Outlook email

Set OutMail = OutApp.CreateItem(0)

strMsg = "Could not start mail for " _
& c.Value
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = strSubj
.Body = strBody
.Attachments.Add _
strSavePath & strPDFName
.Send
End With
On Error GoTo 0
lSent = lSent + 1
If lSent >= lCount Then Exit For


MsgBox "The active worksheet cannot be blank"
Exit Sub


exitHandler:
' Set wsA = Worksheets("Template")
'errHandler:
' MsgBox "Could not create PDF file"
' Resume exitHandler


Next
End Sub



This comment was minimized by the moderator on the site
Hi
Many thanks for the Code but is it possible to save the the PDF automatically to the same location as the active Excel file and with the same file name as the active Excel file?
Many thanks.
Rod
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations