使用 Outlook 以 pdf 格式发送工作表答案

【问题标题】：Send Worksheets as pdf with outlook使用 Outlook 以 pdf 格式发送工作表
【发布时间】：2021-06-18 09:03:27
【问题描述】：

我绝不是 VBA 专家，所以我寻找了一种代码，可以通过电子邮件将 Excel 文件中的工作表发送给不同的收件人。

我使用了这段代码，如果我想以 excel 格式发送文件，这对我来说效果很好。

Sub MailVersand()

Dim OL As Object
Dim IsCreated As Boolean
Dim Wb As Workbook
Dim aWb As Workbook
Dim Ws As Worksheet
Dim An As String
Dim Cc As String
Dim From As String
Dim Subject As String
Dim Dpfad As String
Dim Body As String
Dim clc

Set Wb = ThisWorkbook
With Application
    clc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
If Err Then
    Set OL = CreateObject("Outlook.Application")
    IsCreated = True
End If
On Error GoTo 0

For Each Ws In Wb.Worksheets
    Ws.Copy
    Set aWb = ActiveWorkbook
    aWb.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xlsx"
    Dpfad = aWb.FullName
    An = aWb.Worksheets(1).Range("AB2").Value
    Cc = aWb.Worksheets(1).Range("AF2").Value
    Body = aWb.Worksheets(1).Range("AB5").Value
    From = aWb.Worksheets(1).Range("AB4").Value
    Subject = aWb.Worksheets(1).Range("AB3").Value
    aWb.Close True
    With OL.CreateItem(0)
        .SentOnBehalfOfName = From
        .To = An
        .Cc = Cc
        .Body = Body
        .Subject = Subject
        .Attachments.Add Dpfad
        .Send
    End With
    Kill Dpfad
    Set aWb = Nothing
Next

If IsCreated Then OL.Quit
With Application
    .Calculation = cld
    .ScreenUpdating = True
End With
Set OL = Nothing
Set Wb = Nothing
Set Ws = Nothing

结束子

我现在尝试更改此代码，以便我附加的文件是 pdf 文件。这被证明是相当困难的，但最后我（几乎）做到了。

Sub PDFMailVersand()

Dim OL As Object
Dim IsCreated As Boolean
Dim Wb As Workbook
Dim aWb As Workbook
Dim Ws As Worksheet
Dim An As String
Dim Cc As String
Dim From As String
Dim Subject As String
Dim Dpfad As String
Dim Body As String
Dim strDateiname As String
Dim clc

Set Wb = ThisWorkbook
With Application
    clc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
If Err Then
    Set OL = CreateObject("Outlook.Application")
    IsCreated = True
End If
On Error GoTo 0

For Each Ws In Wb.Worksheets
    Ws.Copy
    Set aWb = ActiveWorkbook
    strDateiname = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strDateiname, _
                     IncludeDocProperties:=False, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False
    An = aWb.Worksheets(1).Range("AB2").Value
    Cc = aWb.Worksheets(1).Range("AF2").Value
    Body = aWb.Worksheets(1).Range("AB5").Value
    From = aWb.Worksheets(1).Range("AB4").Value
    Subject = aWb.Worksheets(1).Range("AB3").Value
    aWb.Close True
    With OL.CreateItem(0)
        .SentOnBehalfOfName = From
        .To = An
        .Cc = Cc
        .Body = Body
        .Subject = Subject
        .Attachments.Add strDateiname
        .Send
    End With
    Kill strDateiname
    Set aWb = Nothing
Next

If IsCreated Then OL.Quit
With Application
    .Calculation = cld
    .ScreenUpdating = True
End With
Set OL = Nothing
Set Wb = Nothing
Set Ws = Nothing

结束子

但我的问题是，现在对于每个工作表，我都会提示保存文件。我怎样才能摆脱它？

【问题讨论】：

标签： excel vba pdf

【解决方案1】：

如果您在发送文档后立即关闭，下面的代码应该可以工作。

显示警报已关闭，因此不会要求您保存工作簿，但在工作簿关闭时会再次启用此功能。

Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

【讨论】：