Consulting

Results 1 to 5 of 5

Thread: Excel VBA Email with PDF attachments

  1. #1
    VBAX Regular
    Joined
    Jul 2018
    Posts
    20
    Location

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

  2. #2
    VBAX Regular
    Joined
    Jul 2018
    Posts
    20
    Location
    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.

  3. #3
    VBAX Mentor Logit's Avatar
    Joined
    Sep 2016
    Posts
    320
    Location
    .
    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
    Attached Files Attached Files

  4. #4
    VBAX Regular
    Joined
    Jul 2018
    Posts
    20
    Location
    hey interesting concept, thanks for this.

  5. #5
    VBAX Mentor Logit's Avatar
    Joined
    Sep 2016
    Posts
    320
    Location
    You are welcome.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •