Question

我已经结合了几个不同的例子中的一些代码来实现这一点，但我的解决方案看起来很笨拙，因为我正在创建2个pdf。一个在临时文件夹中，一个在当前文件夹中。 temp文件夹中的那个是附加到电子邮件的文件夹。我想在当前文件夹中保存一个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文件成功导出到当前文件夹的相同代码，它也不会保存。这是完整的工作代码，但我想在可能的情况下消除temp 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创建文件名的，但它应该是这样的：

如果您从范围中检索它：

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

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

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

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

2 个答案: