Excel VBA：保存和附加工作表为PDF

我已经结合了一些代码从一些不同的例子来得到这个工作，但我的解决scheme似乎klunky，我正在创build2个PDF文件。 一个在临时文件夹中，另一个在当前文件夹中。 临时文件夹中的那个是附加到电子邮件的那个。 我想只保存在当前文件夹中的一个PDF，并附上该PDF到电子邮件。
这是导出两个pdf的代码：

Title = ActiveSheet.Range("B11").Value & " Submittal" ' Define PDF filename in TEMP folder PdfFile = ActiveWorkbook.Name i = InStrRev(PdfFile, ".xl", , vbTextCompare) If i > 1 Then PdfFile = Left(PdfFile, i - 1) PdfFile = Title For Each char In Split("? "" / \ < > * | :") PdfFile = Replace(PdfFile, char, "_") Next PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf" With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True End With 

出于某种原因，如果将ThisWorkbook.Path & "\"添加到第一个导出文件的文件Filename:=ThisWorkbook.Path & "\" & PdfFile ： Filename:=ThisWorkbook.Path & "\" & PdfFile ，所以它保存在当前文件夹而不是临时文件夹，我得到一个运行时错误，它不会保存，即使这是成功导出到当前文件夹的第二个PDF文件相同的代码。 这里是完整的工作代码，但如果可能的话，我想消除临时pdf。

 Sub RightArrow2_Click() Dim IsCreated As Boolean Dim PdfFile As String, Title As String Dim OutlApp As Object Dim i As Long Dim char As Variant Title = ActiveSheet.Range("B11").Value & " Submittal" ' Define PDF filename in TEMP folder PdfFile = ActiveWorkbook.Name i = InStrRev(PdfFile, ".xl", , vbTextCompare) If i > 1 Then PdfFile = Left(PdfFile, i - 1) PdfFile = Title For Each char In Split("? "" / \ < > * | :") PdfFile = Replace(PdfFile, char, "_") Next PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf" 'Debug.Print PdfFile ' Export activesheet as PDF to the temporary folder With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True End With ' Use already open Outlook if possible On Error Resume Next Set OutlApp = GetObject(, "Outlook.Application") If Err Then Set OutlApp = CreateObject("Outlook.Application") IsCreated = True End If On Error GoTo 0 ' Prepare e-mail with PDF attachment With OutlApp.CreateItem(0) ' Prepare e-mail .Subject = Title .To = ActiveSheet.Range("H12").Value .CC = "" .Body = "Please see the attached submittal for " & ActiveSheet.Range("B11").Value & "." & vbLf & vbLf _ & "Thank you," & vbLf & vbLf _ & vbLf .Attachments.Add PdfFile ' Display email On Error Resume Next .Display ' or use .Send ' Return focus to Excel's window Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation Else MsgBox "E-mail successfully sent", vbInformation End If On Error GoTo 0 End With ' Delete the temporary PDF file If Len(Dir(PdfFile)) Then Kill PdfFile ' Try to quit Outlook if it was not previously open If IsCreated Then OutlApp.Quit ' Release the memory of object variable ' Note: sometimes Outlook object can't be released from the memory Set OutlApp = Nothing End Sub 

Answer 1

首先，删除这一行：

 PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) _ & "\" & PdfFile, 251) & ".pdf" 

然后这一行：

 With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=ThisWorkbook.Path _ & "\" & .Range("B11").Value & " Submittal", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End With 

我不知道如何创build您的PDF文件的文件名，但它应该是这样的：

1. 如果你从一个范围内检索它：

    With Thisworkbook PdfFile = .Path & Application.PathSeparator & _ .Sheets("SheetName").Range("B11") & "Submittal.pdf" End With 

2. 如果你需要对文本进行操作，就像你所做的那样：

    Title = ActiveSheet.Range("B11").Value & " Submittal" PdfFile = Title For Each c In Split("? "" / \ < > * | :") PdfFile = Replace(PdfFile, char, "_") Next PdfFile = Thisworkbook.Path & Application.PathSeparator & PdfFile & ".pdf" 

一旦你创build了一个有效的文件名，下面的代码应该可以工作：

 With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=PdfFile, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End With 

Answer 2

在你的描述中，在代码行Filename:=ThisWorkbook.Path & "\" & PdfFile PdfFilevariables包含temp文件夹的path，这就是为什么你会得到错误。