Forum Discussion

chamseddine_hamdeni's avatar
chamseddine_hamdeni
Copper Contributor
Aug 18, 2022
Solved

Send automatic email as PDF attachement from data in excel

I have several sheets (sheet1, sheet2; sheet3, etc.). I want to send the content of these sheets to different email addresses. For example sheet1 to mailto:email1@email.email sheet2 to mailto:emai...
  • Harun24HR's avatar
    Aug 19, 2022

    chamseddine_hamdeni You can try below codes to send individual sheets to separate emails. To understand codes better, I have divided it into 3 parts.

    1. Generate PDF files to insert to email as attachment. You can give sheet names to Split("Sheet1|Sheet2|Sheet3", "|") this array which you want to generate PDF files.
    2.  Send Emails. This will iterate each cells from A2 to downward and send emails to each cell value with attachment from this Split("Sheet1|Sheet2|Sheet3", "|") list of sheets. In this part of codes you can use .Send instead of .Display to send mail directly without displaying it. Testing purpose I have used .Display so that we can check it is generating emails correctly. To Send mails directly without any warning to must enable Programmatic Access to Outlook. Read below articles to enable it. Link 1: slipstick.com , Link 2 , Microsoft Documentation 
    3. Delete PDFs after sending mails (If anyone wish). Sample file is attached herewith.

     

     

     

    Option Explicit
    
    'Generate PDFs for each listed sheet.
    Sub GeneratePDFs()
    Dim strID As String
    Dim shts As Variant, i As Integer
    
    On Error Resume Next
    MkDir ThisWorkbook.Path & "\PDF_Files"
    Err.Clear
    
        strID = Sheets("SendMail").Range("A2").End(xlDown).Address
        
        shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
        For i = LBound(shts) To UBound(shts)
            Sheets(shts(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
            OpenAfterPublish:=False
        Next
        
     MsgBox "PDF file creation finished successfully.", vbInformation, "PDF Creation"
    End Sub
    
    'Send mail to individual each pdf as separate mail.
    Public Sub SendMail()
    Dim strbody As String
    Dim sendTo As String
    Dim emailCell As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim SalaryMonth, strMailRange As String
    Dim shts As Variant, i As Integer
    
        strMailRange = Sheets("SendMail").Range("$A$2").End(xlDown).Address
        strbody = "Please check the attached file."
        shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
        i = 0
            
        For Each emailCell In Sheets("SendMail").Range("$A$2", strMailRange)
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
                With OutMail
                    .Attachments.Add ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf"
                    .to = emailCell
                    .Subject = "Sending Mail As PDF"
                    .HTMLBody = strbody
                    .Display
                    '.Send 'Uncomment this line to send mail directly without displaying it.
                End With
                
            i = i + 1
        Next emailCell
        MsgBox "Mail sending completed successfully.", vbInformation, "Mail Sending"
    End Sub
    
    'Delete PDFs after sending via mail.
    Public Sub DelPDFs()
    On Error Resume Next
        Kill ThisWorkbook.Path & "\PDF_Files\*.*"
        'RmDir ThisWorkbook.Path & "\PDF_Files\"
        MsgBox "All PDF files are deleted.", vbInformation, "Delete PDFs"
    End Sub

     

     

Resources