Looking for the BEST macro/add-in for saving sheets as PDFs and attaching PDFs to Outlook emails

[General Ledger]

Dear All,

I am looking for a macro or add-in that will save an Excel sheet as a PDF and attach the PDF to an Outlook email.

My idea is to have one sheet in the Excel file with a table of sheet names, recipient email addresses, subject lines for the emails, and customized messages for the body of each email. Running the macro/add-in would use the information in the table to generate a separate PDF for each referenced sheet (some sheets might not be needed every time) and email the sheets to the corresponding address(es).

I do not want to hard code the email details (sheet names, email addresses, etc.) into the macro because the information may change and the user of this Excel file is not tech savy.

I realize I may be asking for a lot but I am very confident there is an excellent solution.

I am using Excel and Outlook 2010 with Vista and Adobe Reader.

Thanks so much!!!!

GL

 

[Domenic]

Let's assume that Column A contains the sheet name, Column B contains the email address, Column C contains the subject, and Column D contains the message. Let's further assume that the first row contains the column labels/headers, and that the data starts on the second row, as per the following sample data...

A1:D4:

[TABLE="width: 417"]
<tbody>[TR]
[TD]SheetName[/TD]
[TD]EmailAddress[/TD]
[TD]Subject[/TD]
[TD]Message[/TD]
[/TR]
[TR]
[TD]Sheet2[/TD]
[TD][EMAIL="dom@abc.com"]dom@abc.com[/EMAIL][/TD]
[TD]Project A[/TD]
[TD]With regards to Project A…[/TD]
[/TR]
[TR]
[TD]Sheet3[/TD]
[TD][EMAIL="dan@xyz.com"]dan@xyz.com[/EMAIL][/TD]
[TD]Project B[/TD]
[TD]With regards to Project B…[/TD]
[/TR]
[TR]
[TD]Sheet4[/TD]
[TD][EMAIL="don@xyz.com"]don@xyz.com[/EMAIL][/TD]
[TD]Project C[/TD]
[TD]With regards to Project C…[/TD]
[/TR]
</tbody>[/TABLE]

With the sheet containing the data being the active sheet, the following macro will create a PDF file for each of the specified worksheet and email it using Outlook. Note that the macro uses a function which checks to make sure that the specified worksheet actually exists. When the worksheet exists, it writes "Sent" in Column E. When it doesn't exist, it writes "Sheet does not exist" in Column E. Also, note that as it stands, the code only displays the messages. Once you're satisfied that it works as it should, you can replace...

.Display

with

.Send

[FONT=Courier New][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] test()


    [COLOR=darkblue]Dim[/COLOR] olApp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] olMItm [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strFullName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strSheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [COLOR=darkblue]Set[/COLOR] olApp = CreateObject("Outlook.Application")
    
    [COLOR=darkblue]For[/COLOR] i = 2 [COLOR=darkblue]To[/COLOR] LastRow
        strSheetName = Cells(i, "A").Value
        [COLOR=darkblue]If[/COLOR] SheetExists(strSheetName) [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]With[/COLOR] Sheets(strSheetName)
                strFullName = Application.DefaultFilePath & "\" & .Name & ".pdf"
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFullName
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]Set[/COLOR] olMItm = olApp.CreateItem(0)
            [COLOR=darkblue]With[/COLOR] olMItm
                .To = Cells(i, "B").Value
                .Subject = Cells(i, "C").Value
                .Body = Cells(i, "D").Value
                .Attachments.Add strFullName
                .Display
                [COLOR=green]'.Send[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            Kill strFullName
            Cells(i, "E").Value = "Sent"
        [COLOR=darkblue]Else[/COLOR]
            Cells(i, "E").Value = "Sheet does not exist."
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
      
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[/FONT]

[FONT=Courier New][COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Function[/COLOR] SheetExists(sname [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]    
[COLOR=darkblue]    Dim[/COLOR] x [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    [COLOR=darkblue]Set[/COLOR] x = ActiveWorkbook.Sheets(sname)
    [COLOR=darkblue]If[/COLOR] Err = 0 [COLOR=darkblue]Then[/COLOR]
        SheetExists = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]Else[/COLOR]
        SheetExists = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Function[/COLOR]
[/FONT]

 

[General Ledger]

Demenic,

YOU ARE OUTSTANDING!!!!!!

JUST WHAT I WAS LOOKING FOR AND MUCH MORE.

Thanks so much,

GL

 

[Domenic]

You're very welcome! And thanks for the feedback!

Cheers!

 

[General Ledger]

Domenic,

Please help me wtih an idea that your code sparked. In the macro you have a setting of .Display for testing purposes. Then I am to change it to .Send when done fine tuning the macro. I would like the user to set these options from within the table of email data.

For example, they may want to use Display if they want an opportunity to review the emails before sending. They might want to use Send if they are very comfortable. I think there is also a Draft option(?). They may want to mix these options choosing different settings for different email recipients.

If I make column X in my data table for Email Type, where the user would enter Display, Send or Draft, how can I use this value to control the output of the macro?

Current code:

[COLOR=darkblue]            With[/COLOR] olMItm
                .To = Cells(i, "B").Value
                .Subject = Cells(i, "C").Value
                .Body = Cells(i, "D").Value
                .Attachments.Add strFullName
                .Display
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

Revised code ?? :

[COLOR=darkblue]            With[/COLOR] olMItm
                .To = Cells(i, "B").Value
                .Subject = Cells(i, "C").Value
                .Body = Cells(i, "D").Value
                .Attachments.Add strFullName
                .Display = Cells(i, "X").Value
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

Thanks agiain,

GL

 

[Domenic]

Try replacing...

[LEFT][COLOR=#333333].Display[/COLOR][/LEFT]

with

Select Case Cells(i, "X").Value
    Case "Send": .Send
    Case "Save": .Save
    Case Else: .Display
End Select

...or some variation of the above.

 

[General Ledger]

Domenic,

Once again you provided the perfect solution.

No wonder you are a MVP!!!!

I can not thank you enough.

GL

 

[Domenic]

You're very welcome! And thank you for your kind words!

Cheers!