Excel VBA to send a workbook as two seperate attachments in Outlook

[brade84]

Hi everyone,

So I have a Workbook with two tabs. One is a template, which is a summary of a test I have conducted for my team, and the other one is an Action Plan I need the business to complete. What I am after is a VBA Macro which sends
1. Summary Worksheet as a PDF document.
2. Action Plan Worksheet as a separate Excel document. Bonus points if this can be sent as a Word Document instead.


This is what I have so far, which converts the Summary to a PDF document, but I can't figure out how to send the 2nd attachment

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 = "First part of email message" & variable
strHTMLBody = strHTMLBody & "Second part of email message" & variable
strHTMLBody = strHTMLBody & "Third part of email message" & variable
strHTMLBody = strHTMLBody & "Fourth part of email 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

 

[brade84]

I feel like Im getting close. I found the below code which puts my Action Plan tab into an email. Just having trouble merging the two so it can attach both the PDF and the Action Plan

Sub SendWorkSheet()
 
 'Update 20131209
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
With OutlookMail
    .To = "[EMAIL="skyyang@extendoffice.com"]skyyang@extendoffice.com[/EMAIL]"
    .CC = ""
    .BCC = ""
    .Subject = "kte features"
    .Body = "Please check and read this document."
    .Attachments.Add Wb2.FullName
    .Display
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True

End Sub

 

[brade84]

I feel like I'm so close with this one. I can now attach two document, but it's attaching the Action Plan as both a PDF and Excel document, instead of the Summary (Tab 1) as a PDF and Action Plan (Tab 2) as an Excel book.

If there is anyone out there who can tell me what Im missing, feel free to share.

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 = "Message 1" & variable
strHTMLBody = strHTMLBody & "Message 2" & variable
strHTMLBody = strHTMLBody & "Message 3" & variable
strHTMLBody = strHTMLBody & "Message 4"
 
 ' 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
 
  ' 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
        .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

 

[brade84]

All good now, I have solved it. This thread can be closed now