Real World Scenario
One of my customers (thanks Tony) creates invoices in Excel for his clients and at the end of each month he wants to email these invoices to each of those clients. Each invoice is on a separate worksheet.
If he has a lot of sheets doing this one by one will quickly become a time consuming chore so let’s use some VBA to automate the process.
What We Are Trying To Achieve
We want to create a PDF from each sheet, attach that PDF to an Outlook email and then send it. Before it’s sent we want to be able to add some text in the body of the email and make any other changes we wish.
In this example we will be using Outlook to send emails. Since Outlook 2007 (Service Pack 2) we’ve been able to create a PDF and then email it. You can do this manually by going through the menus and first Saving/Exporting a PDF, then attaching it to an email. Or you can tell Excel to create a PDF and then email it all it one go.
This is ok if we have one or two sheets but, as I said already, if we have a lot of sheets we won’t want to do this because of all the pointing and clicking involved. If you are like me, you’ll want to get it done as quickly as possible.
Are you using Excel 2007 or Earlier?
If you are you'll need to download and install the Save as PDF or XPS add-in from Microsoft so that this code works.
If you are using a version of Excel earlier than 2007 my code won't work for you as the method used to export the file just isn't supported in your version.
So, What does this code actually do?
When you run the macro the VBA code does the following :
- Asks you which folder you want to save the PDF in. The PDF file name is automatically created based on the sheet name and the current month. The current month is taken from cell H6 on the active sheet.
- If that PDF already exists, you are asked if you want to overwrite it.
- Creates the PDF, then creates a new Outlook email and attaches the PDF.
- Displays the email and allows you to type your message, add CC and BCC etc.
Changing How the Code Works
I've tried to make this as easy as possible to modify by yourself. At the top of the code you'll see a section marked You Can Change These Variables. By changing these values you can alter how the code behaves, and how much you have to do once the email is created.
Here's a list of the variables you can change and what they do :
The text in the email subject. This has the current month added to the end, and this is picked up from cell H6. For example if the EmailSubject string is "Invoice for " then the subject of the email will be "Invoice for Sep 2013".
If you want to adapt the code yourself and don't want the current month then just find this section of the code
and make it look like this by
- Adding an apostrophe to the start of the line to comment it out
- Deleting "_" & CurrentMonth &
Do you want to see the PDF after you've created it? TRUE or FALSE.
Do you want to overwrite the PDF if it already exists? If set to TRUE the macro won't ask you to confirm if you do want to overwrite a file that already exists. Set it to FALSE if you want to be prompted.
Do you want to see the email before you send it? If you set this to FALSE then you must specify a recipient, see the next bit.
Email_To, Email_CC, Email_BCC
Enter any default To, CC and BCC recipients for the emails.
You could have the primary recipient's email address in the worksheet and pick this up in the code. To do this you would set Email_To to the value in the relevant cell. In this case we'd want to get the email in cell H1. So you'd type this Email_To = ActiveSheet.Range("H1"). See the animated image below to see what I mean.
Honestly I could write several posts about modifications to this code. It was written this way to address a specific need, but we could get it to do things like :
- Email the workbook
- Email a selection in the sheet
- Send the sheet/workbook/selection in the body of the email, rather than as an attachment
- Get the TO email from the worksheet
- Choose which email account to send from be default, if you have several configured in Outlook.
- Specify multiple sheets to send
- Specify body text in the email
- Loop through all sheets in the workbook and send each one to separate recipients. Or send the all to the same person.
- Prompt for the PDF file name, rather than creating the file name from the sheet name and current month
I think I'll leave those for separate posts, but if you can think of any more I'd love to hear.
Show Me The Code!
If you have any questions please get in touch.If you liked this or know someone who could use it please click the buttons below to share it with your friends and colleagues on LinkedIn, Google+, Facebook and Twitter.
I'm sure I've used Ron de Bruin's code as a starting point for doing this, so thank you Ron.
Option Explicit Sub create_and_email_pdf() ' Author - Philip Treacy :: https://www.linkedin.com/in/philiptreacy ' https://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook ' Date - 14 Oct 2013 ' Create a PDF from the current sheet and email it as an attachment through Outlook Dim EmailSubject As String, EmailSignature As String Dim CurrentMonth As String, DestFolder As String, PDFFile As String Dim Email_To As String, Email_CC As String, Email_BCC As String Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean Dim OverwritePDF As VbMsgBoxResult Dim OutlookApp As Object, OutlookMail As Object CurrentMonth = "" ' ***************************************************** ' ***** You Can Change These Variables ********* EmailSubject = "Invoice Attached for " 'Change this to change the subject of the email. The current month is added to end of subj line OpenPDFAfterCreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE DisplayEmail = True 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work Email_To = "" 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1 Email_CC = "" Email_BCC = "" ' ****************************************************** 'Prompt for file destination With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then DestFolder = .SelectedItems(1) Else MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder" Exit Sub End If End With 'Current month/year stored in H6 (this is a merged cell) CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1) 'Create new PDF file name including path and file extension PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _ & "_" & CurrentMonth & ".pdf" 'If the PDF already exists If Len(Dir(PDFFile)) > 0 Then If AlwaysOverwritePDF = False Then OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists") On Error Resume Next 'If you want to overwrite the file then delete the current one If OverwritePDF = vbYes Then Kill PDFFile Else MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _ & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro" Exit Sub End If Else On Error Resume Next Kill PDFFile End If If Err.Number <> 0 Then MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _ & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File" Exit Sub End If End If 'Create the PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=OpenPDFAfterCreating 'Create an Outlook object and new mail message Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) 'Display email and specify To, Subject, etc With OutlookMail .Display .To = Email_To .CC = Email_CC .BCC = Email_BCC .Subject = EmailSubject & CurrentMonth .Attachments.Add PDFFile If DisplayEmail = False Then .Send End If End With End Sub