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

Status
Not open for further replies.

brade84

New Member
Joined
Feb 24, 2019
Messages
5
Hi all, I think I posted this in the wrong forum, so I thought I would try my luck here.

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. 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.

Code:
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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
54,456
Office Version
  1. 365
Platform
  1. Windows
Duplicate: https://www.mrexcel.com/forum/gener...orkbook-two-seperate-attachments-outlook.html

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread. Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

If you feel that something that has been posted in the wrong forum, you can alert the Moderators by clicking on the "Report" button at the bottom of the screen, and explaining the concern, and they will move it, if deemed necessary.
 
Status
Not open for further replies.

Watch MrExcel Video

Forum statistics

Threads
1,108,960
Messages
5,525,911
Members
409,671
Latest member
nasseralateek

This Week's Hot Topics

Top