PDA

View Full Version : Excel VBA Email with PDF attachments



quanziee
07-11-2018, 09:03 PM
Hi, complete beginner with VBA here. I want to send an email using VBA and attach multiple sheets from the workbook onto the same email, as separate attachments. I found some codes online that attaches a single sheet as a PDF but some of them do not work for me. I'm using Excel-2016. I found one that works but it takes a really long time for the email display to pop up and the code is in no means optimized. Also I'm unable to attach multiple sheets as separate PDFs too.

Here's my code:

Sub AttachMultipleSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Title = Range("C11")

' 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 Sheets("Hotel Booking")
.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 = "..." ' <-- Put email of the recipient here
.CC = "..." ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & vbLf & vbLf _
& "The report is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile 'Trying to attach Sheets("Hotel Booking") here


Dim i As Long
Dim PdfFile2 As String, Title2 As String


' Not sure for what the Title is
Title2 = Range("C15")

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

' Export activesheet as PDF
With Sheets("Cache")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile2, 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")
IsCreated2 = True
End If
OutlApp.Visible = True
On Error GoTo 0

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


.Attachments.Add PdfFile2 'trying to attach Sheets("Cache") here

' 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 With
End Sub

Strapped of time so I also asked this question here:
https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1205387-excel-vba-email-with-pdf-attachments

quanziee
07-11-2018, 09:59 PM
Actually scrap that, I just need to attach one sheet as a PDF into one email. I still need the code above to be fast and optimized.

Logit
07-12-2018, 08:47 AM
.


Option Explicit


Sub Send_Email()


Dim c As Range
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim i As Integer
On Error Resume Next

For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = c.Value
.CC = "Your CC here"
.Subject = "Your Subject here"
.HTMLBody = "Your Body content here"
.Attachments.Add c.Offset(i, 1).Value
.Display
'.Send
End With
Next c


End Sub

quanziee
07-20-2018, 10:32 PM
hey interesting concept, thanks for this.

Logit
07-21-2018, 07:06 AM
You are welcome.