Excel VBA to sending a workbook as seperate documents - excel

Question

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.
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 = "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
If anyone can help out with what else I need to add in this VBA, or have something else to offer, it would be appreciated

Answer 1

Problem solved
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