Excel VBA Email with PDF attachments

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:

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/h...df-attachments

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.

.

Code:

---

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

---

hey interesting concept, thanks for this.

You are welcome.

Hi,

Firstly I have used your macro and it is amazing. Thanks to you!

I need the same macro but shall I request more requirements on the same.

Request if you can add a separate box for the email Subject line and Mail Body in the excel sheet itself so that it can pickup the same.