跳到主要内容

如何将工作表另存为PDF文件并将其作为附件通过Outlook通过电子邮件发送？

在某些情况下，您可能需要通过Outlook将工作表作为PDF文件发送。 通常，您必须手动将工作表另存为PDF文件，然后在Outlook中使用带有该PDF文件作为附件的新电子邮件来发送。 一步一步地手动实现它很耗时。 在本文中，我们将向您展示如何快速将工作表另存为PDF文件并自动将其作为附件通过Excel中的Outlook发送。

将工作表另存为PDF文件并通过VBA代码作为附件通过电子邮件发送

将工作表另存为PDF文件并通过VBA代码作为附件通过电子邮件发送

您可以运行下面的VBA代码以将活动工作表自动保存为PDF文件，然后通过Outlook通过电子邮件将其作为附件发送。 请执行以下操作。

1.打开您将另存为PDF的工作表并发送，然后按 其他 + F11 同时打开 Microsoft Visual Basic应用程序 窗口。

2.在 Microsoft Visual Basic应用程序 窗口中，单击 插页 > 模块。 然后将以下VBA代码复制并粘贴到 代码 窗口。 看截图：

VBA代码：将工作表另存为PDF文件并通过电子邮件发送为附件

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。 按 F5 键来运行代码。 在里面 浏览 对话框，请选择一个文件夹来保存此PDF文件，然后单击 OK 按钮。

:

1.现在，活动工作表将另存为PDF文件。 PDF文件以工作表名称命名。
2.如果活动工作表为空白，则单击“确定”后将出现一个对话框，如下图所示。 OK 按钮。

4.现在，将创建新的Outlook电子邮件，您可以看到PDF文件作为附件列在附件字段中。 看截图：

5.请撰写此电子邮件，然后发送。
6.仅当使用Outlook作为邮件程序时，此代码才可用。

一次轻松地将一个或多个工作表另存为单独的PDF文件：

拆分工作簿 实用程序 Kutools for Excel 可以帮助您轻松地一次将一个工作表或多个工作表另存为单独的PDF文件，如下面的演示所示。 立即下载并尝试！ （30 天免费试用)

相关文章:

最佳办公生产力工具

🤖 Kutools 人工智能助手：基于以下内容彻底改变数据分析： 智能执行   |  生成代码  |  创建自定义公式  |  分析数据并生成图表  |  调用 Kutools 函数...
热门特色: 查找、突出显示或识别重复项   |  删除空白行   |  合并列或单元格而不丢失数据   |   不使用公式进行四舍五入 ...
超级查询: 多条件VLookup  |   多值VLookup  |   跨多个工作表的 VLookup   |   模糊查询 ....
高级下拉列表: 快速创建下拉列表   |  依赖下拉列表   |  多选下拉列表 ....
列管理器: 添加特定数量的列  |  移动列  |  切换隐藏列的可见性状态  |  比较范围和列 ...
特色功能: 网格焦点   |  设计图   |   大方程式酒吧   |  工作簿和工作表管理器   |  资源库 （自动文本）   |  日期选择器   |  合并工作表   |  加密/解密单元格   |  按列表发送电子邮件   |  超级筛选   |   特殊过滤器 （过滤粗体/斜体/删除线...）...
前 15 个工具集:  12 文本 工具 (添加文本, 删除字符，...）   |   50+ 图表 类型 (甘特图，...）   |   40+ 实用 公式 (根据生日计算年龄，...）   |   19 插入 工具 (插入二维码, 从路径插入图片，...）   |   12 转化 工具 (小写金额转大写, 货币兑换，...）   |   7 合并与拆分 工具 (高级组合行, 分裂细胞，...）   |   ... 和更多

使用 Kutools for Excel 增强您的 Excel 技能，体验前所未有的效率。 Kutools for Excel 提供了 300 多种高级功能来提高生产力并节省时间。  单击此处获取您最需要的功能...

产品描述

Office Tab 为 Office 带来选项卡式界面，让您的工作更加轻松

  • 在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50％，并减少数百次鼠标单击！
Comments (67)
Rated 5 out of 5 · 1 ratings
Davide
Davide
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 ?
Reply
0
0
Mayko
Mayko
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
Reply
Report
0
0
crystal
crystal     Mayko
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
Reply
Report
0
0
Zee
Zee
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
Reply
0
0
crystal
crystal     Zee
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
Reply
Report
0
0
Cipri
Cipri
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!
Reply
0
0
crystal
crystal     Cipri
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"
Reply
Report
0
0
Cipri
Cipri
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!
Reply
0
0
crystal
crystal     Cipri
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
Reply
Report
0
0
Yousef
Yousef
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?
Reply
0
0
crystal
crystal     Yousef
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
Reply
Report
0
0
Jurandir
Jurandir
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
Reply
0
0
Rated 5 out of 5
crystal
crystal     Jurandir
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.
Reply
Report
0
0
Sudhy
Sudhy
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
Reply
0
0
Rueben
Rueben
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



Reply
Report
0
0
Rod Bennett
Rod Bennett
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
Reply
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations