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

Question

我已经结合了几个不同示例中的一些代码来使此工作正常，但我的解决方案似乎是klunky，因为我正在创建2个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，所以它在当前文件夹中保存温度，而不是文件夹，我得到一个运行时错误，它不会保存，即使这是成功导出到当前文件夹的第二个PDF文件相同的代码。 以下是完整的工作代码，但我想消除临时PDF如果可能的话： Filename:=ThisWorkbook.Path & "\" & PdfFile 的PdfFile变量包含的路径，这就是为什么在临时文件夹

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 

我不知道你是如何创建文件名的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" 
   

，下面的代码应该工作：

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

Answer 2

在你的描述，在代码的行你会得到错误。