Excel VBA 将工作簿作为单独的文档发送

Question

所以我有一个带有两个选项卡的工作簿。一个是模板，是我为团队进行的测试的总结，另一个是我需要业务完成的行动计划。 我所追求的是一个 VBA 宏，它发送 1. 摘要工作表为 PDF 文档。 2. 行动计划工作表作为单独的 Excel 文档。如果这可以作为 Word 文档发送，则可以加分。

这是我目前所拥有的，它将摘要转换为 PDF 文档，但我不知道如何发送第二个附件

Sub SendEmail()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim strHTMLBody As String
strHTMLBody = "Part 1 of message" & variable
strHTMLBody = strHTMLBody & "Part 2 of message" & variable
strHTMLBody = strHTMLBody & "Part 3 of message" & variable
strHTMLBody = strHTMLBody & "Part 4 of message"


' Not sure for what the Title is
Title = "Control Test Plan: " & Range("C5") & " - " & Range("H5")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

' Export activesheet as PDF
With ActiveSheet.Range("A1:O396")
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile,     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
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
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)



' Prepare e-mail
.Subject = Title
.to = " "
.HTMLBody = strHTMLBody
      .Attachments.Add PdfFile

' Try to send
On Error Resume Next
.Display
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 PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

End Sub

如果有人可以帮助我在此 VBA 中添加其他内容，或提供其他内容，将不胜感激

Answer 1

问题解决了

Sub SendEmail_2()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim strHTMLBody As String
strHTMLBody = "Message 1" & variable
strHTMLBody = strHTMLBody & "Message 2" & variable
strHTMLBody = strHTMLBody & "Message 3" & variable
strHTMLBody = strHTMLBody & "Message 4"

 ' Not sure for what the Title is
  Title = "Control Test Plan: " & Range("C5") & " - " & Range("H5")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet.Range("A1:O396")
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

 ' Update 2702
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
Sheets("Action Plan").Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
    xFile = ".xlsx"
    xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
    If Wb2.HasVBProject Then
        xFile = ".xlsm"
        xFormat = xlOpenXMLWorkbookMacroEnabled
    Else
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    End If
Case Excel8:
    xFile = ".xls"
    xFormat = Excel8
Case xlExcel12:
    xFile = ".xlsb"
    xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = "Action Plan"
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat



  ' 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
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)


    ' Prepare e-mail
    .Subject = Title
    .To = " "
    .HTMLBody = strHTMLBody
        .Attachments.Add PdfFile
        .Attachments.Add Wb2.FullName

    ' Try to send
    On Error Resume Next
    .Display
    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 PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub