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



所以我有一个带有两个选项卡的工作簿。一个是一个模板,这是我为团队进行的测试的摘要,另一个是我需要企业完成的行动计划。我所追求的是发送的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中需要添加的其他内容,或者还需要提供其他内容,那么将不胜感激

解决问题

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

相关内容

  • 没有找到相关文章

最新更新