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

Question

我已经结合了来自几个不同示例的一些代码来使其工作，但我的解决方案似乎很笨拙，因为我正在创建 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：

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

在您的描述中，在代码行中 Filename:=ThisWorkbook.Path & "\" & PdfFile PdfFile 变量包含临时文件夹的路径，这就是您收到错误的原因。

Answer 2

首先，删除这一行：

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. 如果你从 Range 中检索它：

   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