我正在尝试将excel标签转换为PDF，并将每个标签作为附件发送到Outlook中具有不同电子邮件收件人的不同电子邮件上。
例如，选项卡A对应于“供应商电子邮件”选项卡，其中每个选项卡都有“收件人”，“抄送”和“密件抄送”。选项卡B同样适用，但收件人不同。
我的代码：
Option Explicit
Sub create_and_email_pdf()
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""
EmailSubject = "Invoice Attached for "
OpenPDFAfterCreating = True
AlwaysOverwritePDF = False
DisplayEmail = True
Email_To = ThisWorkbook.Sheets("Vendor Emails").Range("B2").Value
Email_CC = ""
Email_BCC = ""
'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
DestFolder = .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
End With
'Current month/year
CurrentMonth = Mid(ThisWorkbook.Sheets("Vendor Emails").Range("E1").Value, InStr(1, ThisWorkbook.Sheets("Vendor Emails").Range("E1").Value, " ") + 1)
'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& "-" & CurrentMonth & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, 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
Else
On Error Resume Next
Kill PDFFile
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
'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
'Display email and specify To, Subject, etc
With OutlookMail
.Display
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = EmailSubject & CurrentMonth
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
End Sub
此行一直存在问题，运行时一直为1004，保存时文件可能是打开/错误：
'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
如果我不使用引用ThisWookbook.Sheets（），我不会遇到任何问题，但是它只会发出我当前正在使用的选项卡，不确定如何指定要转换的选项卡。
为了获得更多的上下文，我要转换的这些选项卡将成为更大工作表的一部分，其中的其他备份选项卡将不会出于内部目的而被发送。
谢谢。