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 :
EmailSubject
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 &
OpenPDFAfterCreating
Do you want to see the PDF after you've created it? TRUE or FALSE.
AlwaysOverwritePDF
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.
DisplayEmail
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.
Further Modifications
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!
Here it is. Grab yourself the workbook, the text file, or copy the code from below.
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
Sam Stillone says
Hi,
I’m hoping you may be able to help me. I have created an excel file that automatically saves the excel file as PDF to my desktop & then sends the PFD as mail attachment. It works wonderfully, so I’d like to share my creation with a couple of friends.
The issue I have is that the macro coding is specific to my user name (i.e. C:\Users\Sam\Desktop), so if you were going to run this on your computer with your user name, it won’t work.
Is there some way that the coding can pick up the user name of anyone that I may share the file with? This would also allow me to share updated versions of my file with others without having to have specific coding for each user on each update. Thank you for your assistance and sharing your knowledge with us.
Catalin Bombea says
Hi Sam,
You can use special folders:
Dim WShell As Object
Dim DesktopPath As String
Set WShell = CreateObject(“WScript.Shell”)
DesktopPath = WShell.SpecialFolders(“Desktop”)
Blake Saggell says
Hello this VBA is amazing it has helped out a lot, but now i would like to only save as .pdf certain page 1 of 1 of certain sheet. i am currently saving a report that fits on print area for page 1 and other info i don”t need to be on the pdf on page 2, i am using this code with out any other editing. How can i achieve this.
P.S i want to save as .pdf only page 1
Catalin Bombea says
Hi Blake,
You can set your sheet print area, to be 1 page only, only print able area is sent to pdf.
If you want from code only, there are more properties on ExortAsFixedFormat method:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FileNm, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=False
The complete list of parameters for this method can be found here.
Aaron says
Is there a way to create the PDF in as a protected PDF (w/password) using the code you mentioned?
Catalin Bombea says
Hi Aaron,
The PDF is created by simply printing the sheet to PDF, the code will not manipulate the PDF structure. To modify the PDF, the code needs to use the Adobe Acrobat API SDK library, it’s a mote complex operation than printing.
Catalin
Sen says
Hi, thanks of this code, its great!
I want to be able to save the PDF file in a specific folder and have the file name automatically inputted with certain cell names. Any suggestions on how to modify the code? Thanks
Catalin Bombea says
Hi Sen,
See this comment for how to create the file name based on sheet cells.
There is an example on our forum describing how to update the code to save PDF’s in a specific folder, please take a look, you will also find there a way to send all sheets to different emails, if needed. For a completely static destination, use:
DestFolder = "D:\PDF Folder"If Len(Dir$(DestFolder, vbDirectory)) = 0 Then MkDir DestFolder
Catalin
Mike Bivona says
Hi, this code is great! You are skilled. Here is what I am trying to do with this code. I want to print the files to pdf, but send an email, without an attachment to someone else. Basically giving them a status of the file. So we create the worksheet and save it currently. Now, a script to automatically email a pre-defined email. Any suggestions?
Catalin Bombea says
Hi Mike,
Look in code after the line:
.Attachments.Add
Remove it, or type an apostrophe at the beginning of this line to disable it, the code will send emails without attachments.
Catalin
Ciara says
Thank you so much for this code! Absolute novice here – can you help me save the file name with a range/data from particular cells?
I’ve adapted this for our purchase order template as best I can.
Ideally I’d like to save as “Purchase Order # (cell F7 in my template)” & “the project name”(cell F6) & the “PO title” (cell A11)
So our example file name would look like “PO#999_Tower1_Steel Beams”
Catalin Bombea says
Hi Ciara,
Try this:
PDFFile = DestFolder & Application.PathSeparator & Range("F7") & "_" & Range("F6") & "_" & Range("A11") & ".pdf"
Celeste says
Thank you for doing this! I am SO CLOSE to getting this up and running. When I run the macro, it prompts me to pick a location to save to, then it successfully creates and names the file and saves it there. Then it opens up an e-mail with the correct subject line and recipient and body just like I wanted it to. But there is no attached file. When I go back to the Excel window I have this:
Run-time error ‘-2147024894 (80070002)’: Cannot find this file. Verify the path and file name are correct.
I click Debug and it’s highlighted on this line:
.Attachments.Add PDFFile
The string PDFFile is the file that it just successfully saved a few microseconds ago… how can it not find the file it literally just created? I check afterward and the file is definitely created.
So very close… once I get over this hurdle, all I have to do is figure out how to get it to run on every worksheet in the file and not just one at a time… but I’ll cross that bridge later on 🙂 thank you!
Celeste says
I got it working! It was so silly… the string PDFFile just tells it what to name the worksheet after it’s exported to PDF… but we can’t use this to identify the file later because the saved file has the extension “.pdf” at the end so it wasn’t finding it because of the extension.
I fixed this by adding at the beginning:
Dim Filename as String
And just before the part where Outlook item is created, I added:
Filename = PDFFile & “.pdf”
And now it works!
Sidenote: this solves the mystery of why the overwrite check was never working. It was always overwriting the file even when it should have been prompting me about the duplicate. But now I know it’s because when it was looking in the directory for the file name, the extension wasn’t there so it would never find a match.
Catalin Bombea says
Hi Celeste,
To send All sheets, use another simple procedure that will call each sheet.
See this topic from our forum for a very similar example: https://www.myonlinetraininghub.com/excel-forum/vba-macros/email#p2844
Cheers,
Catalin
John says
I am a beginner to VBA and was able to copy the code above and it worked but it only created a PDF of the worksheet that the “button” is on. I am hoping that I can add a feature to have the code ask which sheets to copy and email and or, at least just copy to specific sheets (tabs). 99.9% of the time they are just going to email those two sheets, but I am thinking of one off’s when they just want to send one of them. Since I am a beginner, i assume there is a place in the above code that I can type in the worksheet names, is that true?
Catalin Bombea says
Hi John,
Add this code before the “prompt for file destination” line:
Dim SheetName As String
SheetName = Application.InputBox("Type the name of the Sheet to be emailed!")
On Error Resume Next
ThisWorkbook.Worksheets(SheetName).Activate
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
If you type a wrong name, the code will silently exit.
Catalin
John says
This is perfect, but is there a way to request two different sheets (tabs) in that box?
Thank you for this, hopefully there is an answer to get two sheets into one email
Catalin Bombea says
Hi John,
In this case, remove the lines that I sent you in the previous message, and use another procedure, that will call the create_and_email_pdf procedure:
Sub SelectSheets()
Dim SheetName As String, i As Byte
On Error Resume Next
For i = 1 To 2
SheetName = Application.InputBox("Type the name of the Sheet to be emailed!")
ThisWorkbook.Worksheets(SheetName).Activate
If Err.Number = 0 Then create_and_email_pdf
Err.Clear
Next i
On Error GoTo 0
End Sub
If you want more than 2 sheets, change the line For i = 1 To 2 (replace 2 with the desired number of sheets to be sent)
Brent says
Hi there,
All works awesome thanks. How do I change DestFolder from H Drive to the current folder the workbook is in?
Many thanks
Catalin Bombea says
You can simply use:
DestFolder = ThisWorkbook.Path & “\”
William says
Hi
I am trying to get this to work for me as I desperately need to email a nominated sheet of a workbook in excel
I would like to send it as a pdf and add the nominated cell that has the email address in it. I have added that range to the code but cannot get the code to work.
Excuse my ignorance but once I have copied the code into the Workbook “General” how do I get the code to work, I have no idea. I have outlook open and press F5 but nothing happens.
Thanks for your help
Catalin Bombea says
Hi William,
If you have the code in a new module, you can call the macro with Alt+F8, this will open the Run Macro dialog, select the macro from the list and click run, the active sheet will be sent by mail.
Try uploading a sample file to our forum (create a new topic), so we can see why it does not work, if you still cannot make it work.
Catalin
Wills says
I added my request via a new post in the forum as you suggested but have not had a reply yet.
I am a novice with VBA code and if I had another alternative I would probably use it, but I don’t.
Any help you can give me would be great.
thanks
Catalin Bombea says
Hi Wills,
You have a reply in the forum, if you need more help, we can continue the conversation there.
Cheers,
Catalin
jacqueline says
Hi,
This code has been a lifesaver, so thank you very much! The problem I am having is sending the same document to 2 different emails. For some reason, it will only send the document to the first email but twice.
Any help is greatly appreciated! Thanks in advance,
Jacqueline
Catalin Bombea says
Hi Jacqueline,
You can specify as many email addresses you want in the Email_To field, separated by semicolon.
If you cannot manage to do it yourself, you can upload a sample file on our forum, we will help you fix it.
Catalin
jacqueline says
Hi Catalin,
Got it, thanks! I was actually wondering if it’s possible to save multiple sheets of a workbook and combine it into one PDF file but based off a data table which indicates which sheets to combine. I have a data table with customer ID, a list of the sheets the customer needs and their email addresses. Eventually I would like the macro to loop through the data table, save and combine the sheets each customer needs into one file, and send that specific file to their email address or printer. I haven’t found a macro code that quite does this, and I am not sure if this is even possible. However, I’m quite new to VBA, and would appreciate any help 🙂
Thanks so much!
Catalin Bombea says
Excel will not combine PDF files. If you have Adobe acrobat Pro version, excel can combine the PDF’s using the Acrobat library.
Maybe it’s best to create a new sheet, where you can paste ranges from other sheets, then print to pdf this sheet. If the formats are very different, it will not look right.
Anyway, best solution is to use third party software, like PDFCreator, PDf toolkit or Acrobat (first 2 are free). See also this article, it will provide codes for manipulating those pdf tools to combine multiple pdf’s from vba.
Catalin
jacqueline says
Hi! I opted towards creating a macro that would print selected sheets based on a cell. All parts of my code work seperately but when I put it together the code stops at the loop . Wondering if you might be able to help?
Essentially I have a table with a list of sheets in column A, and yes or no (to print) in column B. Column B changes depending on whats in cell E2, and I have a list of numbers that will be pasted in cell E. (So I need the code to go through each number in the list, paste it into column E, print the sheets according to the table, and then move onto the next cell). Hopefully that makes sense!
Sub PrintSheets()
‘Copy and paste cell from list in column H into column E
For j = 2 To 500
If ActiveSheet.Cells(j, 8).Value = “” Then Exit Sub
Cells(j, 8).Select
Selection.copy
Sheets(“Control Sheet”).Select
Range(“E2”).Select
ActiveSheet.Paste
‘Look at table, column A containing all workbook sheets and column B indicating yes/no to print’
Dim i As Integer
i = 2
Do Until Sheets(“Control Sheet”).Cells(i, 1).Value = “”
If Trim(Sheets(“Control Sheet”).Cells(i, 2).Value “”) Then
Sheets(Sheets(“Control Sheet”).Cells(i, 1).Value).Select
ActiveWindow.SelectedSheets.Printout Copies:=1
End If
i = i + 1
Loop
‘Clear Cell E
Range(“E2”).Select
Selection.ClearContents
Next j
End Sub
Catalin Bombea says
Hi Jacqueline,
Can you please upload a sample file on our forum (create a new topic), so we can see and test on your data structure? There are many things that can go wrong, almost impossible to imagine all the possibilities to go wrong 🙂
Thanks for understanding
Catalin
Alan Roberts says
Hi, I am a complete novice using vba, but have managed with this code to change most of the items needed. I would like it to do a couple of other things if possible!
1. I have 2 email accounts one for personal, one for business. I would like this macro to send from my business email by default if possible.
2. Can the pdf be saved to a set folder without having to choose a location.
Your help is greatly appreciated.
Catalin Bombea says
Hi Alan,”
The easiest way is to use this line:
.SentOnBehalfOfName = “””YourName””
Or, use sendfrom account, if you have excel 2007 or higher:
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
Change Item(1) to Item(2) depending on which account you want to send from.
You can use a code like this one to find the account item number:
Sub Find_Account_Number()
Dim OutApp As Object, i As Long
Set OutApp = CreateObject("Outlook.Application")
For i = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(i) & " - Account number: " & i
Next i
End Sub
Ed says
Hi,
I’m finding it hard to create a code to mail the PDF file and combine it with the below code.
I’m not bothered if the PDF’s get overwritten because they will always contain the same info relevant to a certain ref. no.
What do I need to change in your code or what do I need to add to my code if it’s easier.
Any help would be greatly appreciated.
Thanks.
Sub SavePDFHold()
‘
‘ SavePDF Macro
‘
‘
ChDir “X:\XXXXX”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Range(“Q2”).Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub
Catalin Bombea says
Hi Ed,
What exactly are you trying to combine? The code provided in this article already has the Export as PDF code, and that’s all your code does.
I see that you want to assign the pdf name from cell Q2. If that’s what you’re trying to do, look in the code for:
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name & “.pdf”
Simply replace from the above line ActiveSheet.Name with Range(“Q2”).Text and the PDF will be named based on that cell text.
Catalin
Ed says
Got it. Thanks
However, now I came across another issue; Whenever someone inserts a symbol like these / \ : * I’m getting an error when activating the code. I know we’re not supposed to include these symbols when creating a file or folder. What is the best option if I want the code to ignore these symbols when creating the PDF name?
Kind Regards,
Ed
Philip Treacy says
Hi Ed,
You can’t ignore those characters as some of them are invalid when used in filenames. One option is to use a function to remove such chars.
This is Catalin’s code:
He uses a function like this one:
Function ValidateName(ByVal TextString As String, Optional IsSheetName As Boolean = False) As String Dim CurrChar, TheCleanString As String, ChrPos As Integer TheCleanString = "" CurrChar = "" Const ValidChars = "[A-Z,a-z,0-9, ,_,.,-]" For ChrPos = 1 To Len(TextString) CurrChar = Mid(TextString, ChrPos, 1) If CurrChar Like ValidChars Then TheCleanString = TheCleanString & CurrChar Else TheCleanString = TheCleanString & "_" End If Next ValidateName = TheCleanString 'StrConv(TheCleanString, vbProperCase) If IsSheetName Then ValidateName = Replace(Replace(Left(Replace(ValidateName, " ", "_"), 30), "__", "_"), "__", "_") End FunctionEd says
sorted
thanks a lot.
Michelle says
I feel foolish, but I can’t figure out how to change the file destination to a specific folder (the entire team has access to this folder) to keep from folks saving them to their local machine. I’m super rookie at this stuff so please show me exactly where in your code to make the change.
Thanks!
Michelle says
Nevermind! I see that you answered a similar question with new code further below. I don’t know how I missed it the first time. Thanks!
Casey says
This has been a tremendous help with something I’m working on. I’m trying to figure out how to get it to increment the file name if the file already exists in the specified folder. Doesn’t matter how it increments it if it’s adding a number to the end each time and upping that number by one or any other way. If that is not possible, I’d be happy with it populating the save as dialog so long as it could still be PDF and only the individual sheet not the whole workbook.
Any assistance would be great.
Catalin Bombea says
Hi Casey,
You should add a time stamp at the end of the file name, it’s much more easier. Use Format(Now(),”yyyy-mm-dd-hh-mm-ss”), you will never have duplicates.
To evaluate all file names from a folder, you need to write specific code. Try:
Counter=1FName=ThisWorkbook.Path & "\Test" & ".pdf"
Do While Len(Dir(FName)) <> 0
FName= ThisWorkbook.Path & "\Test_" & Format$(Counter, "00") & ".pdf"
Counter= Counter+ 1 'increment the index number, to find the next free number
Loop
'now you can use this name to save the file
Casey says
Catalin,
Pardon my ignorance here, but I’m very new to this. I’m assuming the code you provided goes somewhere in the section I pasted here, but maybe I’m wrong? Also where does the Format(Now(),”yyyy-mm-dd-hh-mm-ss”), come into play?
‘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 “Please give the file a unique name in the designated box at the top of the sheet.”
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
Catalin Bombea says
The time stamp should go into the file name:
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _& “_” & CurrentMonth & "-" & Format(Now(),”yyyy-mm-dd-hh-mm-ss”) & “.pdf”
Casey says
You are amazing. This is exactly what I needed. Thank you so much!
Bambino says
I cant tell you how helpful this has been to me! I have made a couple changes to the code and now it is not fitting the excel sheet to 1 page width and is running information off the side. How can I prevent this from happening?
I was thinking I could add something in this script
‘Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
Catalin Bombea says
Hi,
Before the code that creates the PDF, you have to redefine the Print Area:
Worksheets(“Sheet1″).PageSetup.PrintArea=”A1:H100”
Change that range as needed.
Renee M. Hinojosa says
HI! I must have tried every single one of your codes to try and get this to work but I have had no luck (8 hours of my day). The sad part about it is that so many people have asked the question but I think I am lacking in where to put my information:
Here is my situation and I am hoping you can help me:
I have a sheet that auto populates depending on the Name that is chosen from a drop list. For example: I chose a Vendor and the items they sell auto populate onto the sheet. In this same sheet, I have created a macro that allows me to send this sheet as a PDF but I would like for the PDF File name to change in accordance with the name chosen from the drop down list. The drop down list is on Cell “C4″…I don’t need to save a copy of it, I just want the PDF file name to read the information on cell C4 + Receiving Report + the date.
I’m not even sure any of this made sense but I promise i tried for a long time.
Thank you in advance for reading my post!
Catalin Bombea says
Hi Renee,
Can you please upload a sample file with your structure and code?
It will be a lot easier to help you. Here is a link to our Forum. (create a new topic)
Catalin
Sam says
Hi, I am very new at this and need help. I keep getting an error message that “Sub or Function not defined”.
Thank you!
Catalin Bombea says
Hi Sam,
Most probably you are calling a procedure but there is a typo in the procedure name. Make sure that the sub name is spelled correctly.
You can also upload your sample file to our forum, so we can take a look for you.
Catalin
Lee Wood says
Hi both,
I am looking for the same code; I would like to email sheet 1 instead of the active sheet. Sheet 1 is called “Request” in my workbook.
I appreciate any support with this.
Also, thank you for the code, it has really helped!
L.E.:
Hi there,
Thank you so much for this VBA, it is a great help.
I am looking to have this VBA on Sheet2 of my workbook but for it to save and attach Sheet1.
Any ideas?
Many thanks,
Catalin Bombea says
Hi Lee,
The code is meant to be used in a normal module, not in a sheet module.
Replace the text “ActiveSheet” from code with : ThisWorkbook.Worksheets(“Request”) or with the vb code name Sheet1. Make sure you have the necessary info in this sheet (email, date)
Cheers,
Catalin
Dennis says
Hi
Thanks for the code it works great but i have a question about the active sheet, i am hoping that you cant help me? how do i set up the code that it always create the PDF from sheet 1 and not the active sheet?
Thanks
Dennis
Dennis says
never mind i figure it out me self, just needed to open my eyes 🙂
Philip Treacy says
🙂 Glad you figured it out Dennis.
Regards
Phil
Tracey says
Hi Catalin
Thank you so my for this code. It has made a huge difference to speed up daily repetitive tasks.
Would you be able to help me with just one small amendment I need?
I have several sheets in my workbook but would like it to convert sheets 2 & 6 to separate PDFs and attach to the same email.
Thank you
Tracey
Catalin Bombea says
Hi Tracey,
If you can upload a sample file with your sheets and code on our Forum, it will be more easier to help you, I will make changes to the version of the code you are using.
Here is the link to Forum: Excel Forum
Adrian Lance says
Hi.
This code is great and with a few minor tweaks does almost everything I need, thanks. The only things I can’t work out are;
1. how to add body text to the e-mail, ideally based on certain cells in the active sheet. I have tried to use Email_Body = “Hi” but this doesn’t work, what should I use instead of Email_body?
2. how to default where the pdf is saved.
Thanks in advance.
Adrian
Philip Treacy says
Hi Adrian,
You were on the right track. You need to specify a variable for the email body, which I’ve called Email_Body, but once you’ve given this a value (some text), you need to add it to the email. In the section of code that begins With OutlookMail you’ll see I’ve added the line .body = Email_Body which inserts the text into the body of the email.
Where the variables are defined, I’ve set the body to the contents of A1, you can set this to whatever you want.
The location where the PDF is created is controlled by the DestFolder variable. I’ve removed the section of code that prompts the user to select a folder, and manually defined DestFolder as c:\temp. Again you can set this to whatever you want, even using a cell to specify the folder.
You can download the workbook here.
Regards
Phil
Matt Lewendon says
Hello
First thanks for all the efforts with the code.
The code above to have the email body text automatically insert in the email from an active cell works great.
Is there anyway the email signature and the email body text can be in the same email automatically?
The email signature is overwritten by the text being inserted automatically.
Thanks Matt
Catalin Bombea says
Hi Matt,
Use this:
.HtmlBody=ActiveCell.Text & .HtmlBody
This will append the existing signature to active cell text.
Catalin
Barry says
Hi I have been using this code for a number of months to email PDF reports every day, Its great, but If I could show a Preview of the PDF in the email body it would be great.
I tried to use this code supplied to Adrian, but I cannot get it to do what I need. I want to insert a Preview of the PDF attachment into the email Body,
Thanks in advance,
Catalin Bombea says
Hi Barry,
You have to save a range from the sheet that is converted to PDF as an image, then add that image to .HTMLBody.
This is the code that will save a range as image:
Sub SaveAsJPG(Rng as Range, FName as String)Dim Cht As Chart, Img As Picture
Set Cht = Charts.Add
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
Cht.Export FileName:=FName, Filtername:="JPG"
Cht.Delete
End Sub
You can call this procedure and pass the range and the file name:
SaveAsJPG Range(“A1:H10”), “C:\temp\ImageName.jpg”
Then, in the send email code, add the image as an attachment, then refer to this attached image in the HTML body:
.Attachments.Add “C:\temp\ImageName.jpg”
Take a look at the image from the link below for a sample HTML string.
Sample HTML string
Barry says
Hi thanks for the help, I tried adding these pieces of code to my file but I’m doing something wrong.. I don’t know where it should be added.
Could you help if I post the current code here?
Catalin Bombea says
Hi Barry,
Can you upload a sample file with your code to our forum? It will be easier to help you.
Catalin
bgdl says
Catalin
Thanks once again for your help, I have added a new thread in the forum,
https://www.myonlinetraininghub.com/excel-forum/vba-macros/preview-attachment-in-email-body#p2091
Regards
Barry
Matt says
Hello Catalin,
I would really like to know how to:
Loop through all sheets in the workbook and send each one to separate recipients.
Thanks,
Matt
Catalin Bombea says
Hi Matt,
See this message: Loop Through Sheets, you will find a sample code to loop through all sheets. If you need help to apply it, you can upload your file on our forum, to see your structure.
Catalin
Rich says
Is there a way to loop through only certain tabs? I don’t need all tabs to create a PDF file or to be emailed.
There are 29 tabs that I need to PDF and send, but there are 37 total tabs. Can you help?
Thanks,
Rich
Catalin Bombea says
Hi Rich,
You can set a list to exclude:
Dim ExcludeList as StringExcludeList="Sheet1, Sheet2, Sheet3"
If Instr(ExcludeList, Sheet.Name)>0 then
msgbox "This sheet will not be printed"
End If
joe says
Hey Catalin,
thanks for getting back to me. The data is quite sensitive so I will have to anonymise it before upload.
The data to be transferred is simply a Today() formula
Joe says
First off, fantastic code, and thank you for the efforts both creating then sharing the solution. I have also at times used Ron De Bruins code to aid dissemination of reporting data though stumbled on this when I had issues pdf-ing using that solution.
I did have a couple of question though not sure if you can help. I am using the code further down in the comments. Thank you in advance regardless.
1. My spreadsheets contains sheets with only data, that doesn’t need to be sent, is there means to skip these ? Ron’s code contained an IF statement that i have tried to replicated though haven’t been able to best locate the End IF statement for closure.
“If Wks.Range(“A3”).Value Like “?*@?*.?*” Then”
2. The worksheets containing data to be sent have two pivot charts side by side,to avoid data refresh overwriting if placed below. The right side chart is longer than the left (unfortunately it needs to be in this order). As a result when pdf-ing there are a number of blank pages following the first chart as the chart prints all empty pages adjacent to the right hand chart. Is there means to not pdf those pages without content?
3. pdf file name – I have tried to amend the pdf file name to include the content of a cell by using the following code though this results in the pdf not attaching to the email where there is data in cell B4.
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “-” & ActiveSheet.Range(“B4”) & “.pdf”
Catalin Bombea says
Hi Joe,
You can upload a sample file with your code and pivot tables on our new forum: excel-forum
Basically, you can print to pdf each pivot table separately (print a range instead of the entire sheet), this will create 2 pdf’s with different sizes.
What type of data do you have in cell B4? That cell should not have chars that cannot be used in file names.
joe says
Hey Catalin,
I have tried to remove sensitive data in order to submit to the forum though have rendered the sheet as a shadow of what it needs to be to demonstrate needs.
Its probably asking a bit much though if you could suggest the code required to set print area for each pdf that would be grand,
the code i am using is as per below – :
Option Explicit
Sub create_and_email_pdf_ALL()
‘ Author – Philip Treacy :: http://www.linkedin.com/in/philiptreacy
‘ http://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
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String, Email_Body2 As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim Wks As Worksheet
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
For Each Wks In ThisWorkbook.Worksheets
Application.Goto Wks.Cells(1, 1)
EmailSubject = “Utility Forecast – TEST – ” & ActiveSheet.Range(“B4″) & ” ” & ActiveSheet.Range(“E2”)
OpenPDFAfterCreating = False
AlwaysOverwritePDF = True
DisplayEmail = False
Email_To = ActiveSheet.Range(“A3”)
Email_CC = “”
Email_BCC = “”
Email_Body = “Hi There” & vbLf & vbLf & _
” ” & vbLf & _
“Should you have any questions or queries then please direct these to your allocated Account Manager” & vbLf & vbLf & _
” ” & vbLf & _
“Yours sincerely” & vbLf & vbLf & _
” ” & vbLf & _
“” & vbLf & _
“” & vbLf & _
“” & vbLf & _
“”
‘Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “-” & “.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
.Body = Email_Body & .Body
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
Next Wks
End Sub
Catalin Bombea says
Hi Joe,
Instead of ActiveSheet.ExportAsFixedFormat…
use:
Sheets(“Sheet1”).Range(“A1:J30”).ExportAsFixedFormat…
This will print only the indicated range, not the entire sheet.
Martin says
Thanks Philip – Useful and easy to implement 🙂
Philip Treacy says
You’re welcome.
Phil
Martin Welsh says
This is great but sometimes I get the error:
Run Time Error “1004” – Document not saved. The document may be open or an error may have been encountered when saving.
If I press the debug button, the following code is highlighted
‘Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
If I press “End” and then run the macro again, it works fine.
Any ideas?
Cheers,
Martin
Philip Treacy says
Hi Martin,
What are the names of the sheets that you are saving when this error occurs? If the sheet names contains characters ( like ” <> | ) that are invalid for filenames you could get this error.
Add this line of code immediately before the section of code you quoted above. This will print the file name that VBA is trying to create to the Immediate Window in the VBA editor.
Regards
Phil
Martin says
Hi Phil!
Thanks for the info.
This is what is displayed in the debug window.
C:\Users\temp\Desktop\Workshop KPIs_.pdf
C:\Users\temp\Workshop KPIs_.pdf
C:\Users\Workshop KPIs_.pdf
\\abc.ds.abc.net\cli-hm\hm0230\temp\My Documents\Workshop KPIs_.pdf
Libraries\Workshop KPIs_.pdf
It works fine for the first 2 or 3 times and the error message is displayed.
Philip Treacy says
Hi Martin,
Is everything ok for the first 3 runs:
C:\Users\temp\Desktop\Workshop KPIs_.pdf
C:\Users\temp\Workshop KPIs_.pdf
C:\Users\Workshop KPIs_.pdf
and the error occurs on one of these:
\\abc.ds.abc.net\cli-hm\hm0230\temp\My Documents\Workshop KPIs_.pdf
Libraries\Workshop KPIs_.pdf
This is a network location \\abc.ds.abc.net\cli-hm\hm0230\temp\My Documents\Workshop KPIs_.pdf. Do you have access to this computer and folder? Can you open this location in Windows Explorer?
\\abc.ds.abc.net\cli-hm\hm0230\temp\My Documents\
Phil
Martin says
Yes, I can see the PDF file in the Network folder but you’re right I think this is where the problem could be.
I’ve now changed to saving to my desktop and I’ve run the macro six times and it’s not crashed. What I think could be the issue, is that when I choose my network folder, I don’t always get the message box, asking me if I want to over write the existing file…….
Many thanks for your great support with this.
Philip Treacy says
No worries Martin, glad you got it resolved.
Phil
Luis says
Thanks for sharing! I have been after something along these lines for quite some time. Is there any chance this could work for excel for Mac when using the default mail app as opposed to outlook?
Philip Treacy says
Hi Luis,
This code won’t work as it is for Mac because I’ve coded it to use Outlook. You’ll need a Mac specific script and Ron de Bruin has produced these, check this page
http://www.rondebruin.nl/mac/mail.htm
Regards
Phil
karlon says
How do I get this macro to do the same for each worksheet in the file saving each worksheet as a pdf by worksheet name each separately?
Catalin Bombea says
Hi Karlon,
Take a look at this comment, you will find there the code you need. It will save as pdf and send each worksheet to a different email address. Instead of the name created, you can use the ActiveSheet.Name to save the file with the sheet name.
Catalin
DG says
Hi Catlin
I have a workbook with 100 tabs of RCTI. I need to send them to different recipients whose email is mentioned in each worksheet in Cell G11.
How can I convert each worksheet to pdf and email each to different recipients in one go. I am new to VB
Catalin Bombea says
Hi DG,
Take a look at this comment, it contains a functional code to email each sheet to a different address. All you have to do is to press ALT+F11 in your excel workbook to open the VB Editor, from the menu choose Insert-Module, then paste the code in the right side panel. Look after the text G15, which indicates the destination email and replace it with G11, it’s a simple replacement.
You might also want to change the file name, which is now based on cell G14:
CurrentMonth = Mid(ActiveSheet.Range("G14").Value, InStr(1, ActiveSheet.Range("G14").Value, " ") + 1)You can use
Activesheet.Name, or Activesheet.Name & " - " & Format(Date,"yyyy-mm-dd")Let me know if you managed to make it work.
If you still have problems, you can send the file via our Help Desk, I’ll take a look at it for you.
Cheers,
Catalin
Chase Michaels says
First I must tell you, I have know idea what I am doing. I have been using Ron De Bruin’s codes for many years. If someone could help me. His code helps but I still am not automated as much as I would like.
I have timecards that I need to email out each week. They are on 1 sheet. So A20:M36 would be 1st timecard, A37:M51
I would like to create and save the PDF file then automatically send them
On 1st timecard
To: A36 “email_address”
Subject: I20 “Time Card” & K20 “Date”
Create using Range A20:M36
FileName: H22: “employee ID #” & Underscore “_” & Date “K20” .PDF
Save to folder: C:\timecards\
2nd Timecard
To: A37 “email_address”
Subject: I37 “Time Card” & K37 “Date”
Create using Range A37:M53
FileName: H39: “employee ID #” & Underscore “_” & Date “K37” .PDF
Save to folder: C:\timecards
I have seen this type of function if each timecard was on a separate sheet. It would check for an email address in a specific cell, then create and send it.
•Email a selection in the sheet
•Get the TO email from the worksheet
•Specify body text in the email
•Loop through entire sheet and send each one to separate recipients their range of cells
•Choose which email account to send from be default, if you have several configured in Outlook.
•Create file name, save & send using specific cells
Hope I was able to explain this. Stuff you guys do is well above my paygrade.
Thank you for any help you guys could give me,
Chase
Catalin Bombea says
Hi Chase,
This version seems to be close to what you need:
Sub create_and_email_pdf()' Author - Philip Treacy :: http://www.linkedin.com/in/philiptreacy
' http://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
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String, Email_Body2 As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim i As Byte, Rng As Range
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
For i = 1 To 2
If i = 1 Then Rng = ActiveSheet.Range("A20:M36")
If i = 2 Then Rng = ActiveSheet.Range("A37:M53")
OpenPDFAfterCreating = False
AlwaysOverwritePDF = False
DisplayEmail = True
Email_To = Rng.Cells(1, 1)
Email_CC = ""
Email_BCC = ""
EmailSubject = Rng.Cells(1, 1).Offset(0, 8) & " Time card " & Rng.Cells(1, 1).Offset(0, 10)
Email_Body = "Good afternoon !" & vbCrLf & "Attached please find your latest statement for payment."
If Len(Email_To) > 0 Then
CurrentMonth = Mid(ActiveSheet.Range("G14").Value, InStr(1, ActiveSheet.Range("G14").Value, " ") + 1)
'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & "employee ID#" & Rng.Cells(1, 1).Offset(2, 7) & "_" & Rng.Cells(1, 1).Offset(0, 10) & ".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
.HTMLBody = Email_Body & .HTMLBody
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
End If
Next i
End Sub
Catalin
steven says
Hi Catalin
As an excel expert, are you aware of examples available for Creditors Control forms including VBA coding that can be edited to suite ones needs.
Any feedback will be appreciated.
Catalin Bombea says
Unfortunately, I never searched for ready made forms, I build anything I need, so i cannot give you an example.
It’s not rocket science though, you should start your own form, during this process you will definitely learn many new and useful things 🙂
Catalin
steven says
Thanks for feedback Catalin
I will do
steven says
Hi there
What string of code can I insert and where…. to achieve the following:
Search through all wks and only perform task if the Email to: has a value. If Email to: is blank, then don’t perform the task for that wks only, but for all other wks.
Your assistance will be appreciated.
Catalin Bombea says
Hi Steven,
This version may work for you:
Option ExplicitSub create_and_email_pdf()
' Author - Philip Treacy :: http://www.linkedin.com/in/philiptreacy
' http://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
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String, Email_Body2 As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim Wks As Worksheet
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
For Each Wks In ThisWorkbook.Worksheets
Application.Goto Wks.Cells(1, 1)
CurrentMonth = ActiveSheet.Range("G14")
EmailSubject = "Invoice attached for "
OpenPDFAfterCreating = False
AlwaysOverwritePDF = False
DisplayEmail = True
Email_To = ActiveSheet.Range("G15")
Email_CC = ""
Email_BCC = ""
Email_Body = "Good afternoon !" & vbCrLf & "Attached please find your latest statement for payment."
If Len(Email_To) > 0 Then
CurrentMonth = Mid(ActiveSheet.Range("G14").Value, InStr(1, ActiveSheet.Range("G14").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
.HTMLBody = Email_Body & .HTMLBody
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
End If
Next Wks
End Sub
Catalin
steven says
Hi Catalin
You are a star as always. Thanks so much. I aspire to have your knowledge.
Catalin Bombea says
You’re welcome Steven
As you already know, you’re in the right place to gain knowledge 🙂
Catalin
iain says
Excellent code, thank you for sharing your knowledge… as with everyone, I am after one little tweak but I can’t figure it out on my own, hope you can help.
When you are saving the pdf, how can I change that code:
‘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
****************************
How can I change the code to select the exact same folder each time via the VBA (I don’t want to change my computers default path, just this save function)
Thoughts?
Catalin Bombea says
Hi,
All you have to do is to replace the entire code you mentioned with this:
DestFolder = “D:\My Folder Name” ‘make sure you type the correct path to your desired folder
Catalin
steven says
Hi, thank you so much for the code….really helps to simplify my invoicing.
I am however trying to get the code to send off the invoices of all worksheets within this workbook at once. i have copied in code from a previous comment but fail to make it work. This is the first time I am working with Code. Can you please have a look and see where my error lies.
Thank
L.E.: The code below is corrected and functional, to email each worksheet to the email address from cell G15. There is also another cell used in code, cell G14 (for month name), you can use it or remove it from code.
Option ExplicitSub create_and_email_pdf()
' Author - Philip Treacy :: http://www.linkedin.com/in/philiptreacy
' http://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
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String, Email_Body2 As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim Wks As Worksheet
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
For Each Wks In ThisWorkbook.Worksheets
Application.Goto Wks.Cells(1, 1)
CurrentMonth = ActiveSheet.Range("G14")
EmailSubject = "Invoice attached for "
OpenPDFAfterCreating = False
AlwaysOverwritePDF = False
DisplayEmail = True
Email_To = ActiveSheet.Range("G15")
Email_CC = ""
Email_BCC = ""
Email_Body = "Good afternoon " & ActiveSheet.Range("B13") & vbCrLf & "Attached please find your latest statement for payment."
CurrentMonth = Mid(ActiveSheet.Range("G14").Value, InStr(1, ActiveSheet.Range("G14").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
.HTMLBody = Email_Body & .HTMLBody
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
Next Wks
End Sub
Catalin Bombea says
Hi Steven,
If you copied it, you cannot be the author, right? 😉
If the cell contains text with multiple email addresses separated with semicolons, the code will work, you don’t have to do something special.
Catalin
steven says
Hi Catalin
You are absolutely correct. My Bad. I just assumed one could edit all green fields.
Thank you for advise, i will upload sample file.
Catalin Bombea says
Great then, you already have a reply on Help Desk 🙂
Catalin
Karen says
Hi – this is amazing. Exactly what I needed so thanks.
I have one modification I need help with please. I have a drop down menu with different store names as options for the drop down. I want to say if “X” store, email to “Y” email address. Is this possible? So say the drop down is cell X3. Where would I add the code into the above and what would it be?
Thanks in advance!
Catalin Bombea says
Hi Karen,
You need to have a list of store names and email addresses. Then, next to your dropdown with store name, you can set a formula to extract from that list the email address.
For example, if in A1:A10 you have store names, and in the next column B1:B10 you have email addresses for these stores, the formula (which can be placed anywhere, or next to the dropdown) will be:
=INDEX(B1:B10,MATCH(F25,A1:A10,0))
In the example formula above, cell F25 is the cell with the dropdown, where you select the store name. Assuming that you place this formula in the cell next to the dropdown cell, G25, you can refer to this in your code, at the .To parameter:
.To=Worksheets("Sheet1").cells(25,"G")
If you need more help, you can open a new ticket on Help Desk, with a sample file attached, I will help you 🙂 .
Cheers,
Catalin
Karl says
Hiya love the code,
Very handy although i was wondering on how we can do this for a button on another tab.
but then send a seprate tab, ie the button is on worksheet 1 , but this sends worksheet 2?
Catalin Bombea says
Hi Karl,
Please upload your sample file and describe iin detail what you want to do, it’s easier to work on your file.
You can use our Help Desk.
Cheers,
Catalin
sharon says
Hi
I had this working wonderfully but now am having some issues with the pdf saving the correct range of information in the worksheet…. which no goes across two pages but wants to save as 4 pages….
also when the code is displaying the .pdf before emailing, I sometimes get this error ‘there was an error opening this document. This file is already open or in use by another application….
any suggestions welcomed
In the meantime I am going to re create the file but would be interested in seeing if there is indeed a fix…
am using Excel 2010 and Adobe Reader XI
rgds
Sharon
Catalin Bombea says
Hi Sharon,
You can try setting the page width to 1 page , instead of automatic. Can you share the code you are using? Is there a reason to open the file before sending by email?
You can use our Help Desk to upload a sample file.
Cheers,
Catalin
Sharon says
Thanks Catalin
I have used the above code with the exception of fail path name and I have OpenPDFAfterCreating = True
set print view to one column and is working (at the moment)
My issue seems to be in the open pdf after creating:
1. the file does not open – this is where there is an adobe pop up that tells me the ‘There was an error opening this document. The file is already open or in use by another application
2. the file is saved to the correct location
3. the file is correct that is attached to the email
As an aside question, how do I set the page width to one page instead of fixed format in the code
rgds
Catalin Bombea says
Hi Sharon,
You can set the page width to 1 page from Page setup menu (you have the option in ribbon, Page Layout tab, Scale to Fit group).
Seems that the error is Adobe Reader related, not to your code. Try to close all processes related to Adobe Reader from Task Manager-Processes, before running the code.
I was not able to recreate the error, i will try on another machine with Reader installed.
Cheers,
Catalin
Christof Linde says
This was very helpful. All I want to add is that it also save a copy of the current sheet to a new excel file with the same filename, but not attach it to email.
I want a PDF and Excel copy.
How can I do that?
Catalin Bombea says
Hi Christof,
you can use code like this:
Sub SaveSheet()Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
FPath = "G:\Sheets"
FName = ActiveSheet.Name & Format(Date, "ddmmyy") & ".xls" 'change extension
Set NewBook = Workbooks.Add
ActiveSheet.Copy Before:=NewBook.Sheets(1)
If Dir(FPath & "\" & FName) <> "" Then
MsgBox "File " & FPath & "\" & FName & " already exists"
Else
NewBook.SaveAs Filename:=FPath & "\" & FName
End If
End Sub
If you need more help, you can open a ticket, with your sample file uploaded on our Help Desk.
Cheers,
Catalin
Keith says
Hi there – I have a send reminder email issue on VBA. This is uses a command button to acknowledge content of specific cell and then will send a reminder email through excel using VBA. I keep on getting the same error. I would appreciate some assistance or feedback.
Keith Gold
Catalin Bombea says
Hi Keith,
Please describe the problem, you can upload the file to analyze it on our Help Desk system:
I will gladly help you solve this problem 🙂
Cheers,
Catalin
Skye says
What edits would you make to this code in order to do this as you specified earlier?
“Loop through all sheets in the workbook and send each one to separate recipients. Or send the all to the same person.”
Any and all help is wonderful since I am brand new to VBA.
I know I have to do something with this like you mentioned earlier. But I cant seem to figure out how to have each sheet go to another person. Each sheet will always be going to the same person. I’m just not sure how to specify this.
Dim Wks As Worksheet
For Each Wks In ThisWorkbook.Worksheets
Application.Goto Wks.Cells(1, 1)
PDFFile = DestFolder & Application.PathSeparator & Wks _
& “.pdf”
Next Wks
Catalin Bombea says
Hi Skye,
You have to provide the destination email address for each worksheet.
You may set a specific cell, the same in all sheets, to hold the address for each sheet destination email. For example, cell M2 of each sheet stores the address, then the loop will look like:
For Each Wks in ThisWorkbook.WorksheetsPDFFile = DestFolder & Application.PathSeparator & Wks.Name & “.pdf”
'...create email code
'write the destination address:
.To=Wks.Cells(2,"M")
'attach the file
.Attachments.Add PDFFile
'...rest of code
Next
But if you want to send all sheets to the same address, the loop makes no sense, you can simply create a single PDF file from the entire workbook, and attach it to the email message.
Cheers,
Catalin
DeWaal says
Hi Phil
This is amazing, exactly what i needed.
I just need your help with one thing. I need text in my e-mail body as wel based on a few cell values, i played around with the code a bit but it does not work.
Please see below what i did.
Hope you can help me out with this.
Private Sub CommandButton1_Click()
‘ Author – Philip Treacy :: http://www.linkedin.com/in/philiptreacy
‘ http://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, Email_Body 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 = “MVA Aluminium (Pty) Ltd – Quotation” & ActiveSheet.Range(“F16 “) & ” – ” & ActiveSheet.Range(“C13 “) & ” – ” & ActiveSheet.Range(“c18”) ‘Change this to change the subject of the email. The current month is added to end of subj line
OpenPDFAfterCreating = True ‘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 = ActiveSheet.Range(“c19”) ‘Change this if you want to specify To email e.g. ActiveSheet.Range(“H1”) to get email from cell H1
Email_CC = “”
Email_BCC = “”
Email_Body = “Hi,” & Range(“c13”) & vbLf & vbLf _
& “Hope you are well.” & vbLf & vbLf _
& “Please find attached your quotation for you House/Site at ” & Range(“c18”) & vbLf & vbLf _
& “Please let me know if there is anything you dont understand, or if there is anything else i can help you with.” & vbLf & vbLf _
‘ ******************************************************
‘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 = ActiveWorkbook.FullName
i = InStrRev(PDFFile, “.”)
If i > 1 Then PDFFile = Left(PDFFile, i – 1)
PDFFile = PDFFile & “.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
Catalin Bombea says
Hi,
I can see that you prepared a text: Email_Body = “Hi,” & Range……
But you are not using it in your email…You should have a .Body field in your code:
With OutlookMail.Display
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = EmailSubject & CurrentMonth
.Body = Email_Body
.Attachments.Add PDFFile
If DisplayEmail = False Then
.Send
End If
End With
Cheers,
Catalin
Kassi says
I’ve used Ron’s code to set up a PDF that sends to outlook. It’s worked wonderfully for 9 months, and all of a sudden received an error note, “This macro will only work if the file is Saved once.” I’ve had to re-create the document 2 months in a row to re-send. There’s 40 tabs we’re emailing out as individual PDF to emails and have lost 2 business days recreating the document with appropriate links. Please help!
Philip Treacy says
Hi Kassi,
When you say “Ron’s code” do you mean the code on this page or code from Ron de Bruin’s website ?
Can you please open a ticket on the Helpdesk and send us your workbook so I can have a look at the code.
Thanks
Phil
Lori says
Hi Phil,
This macro works perfectly; however, I have 186 tabs in my worksheet and I have to click on each tab to run the macro. Is there anyway for it to create the pdf and e-mail to the address in a certain cell for each sheet all at once?
Thank you!
Catalin Bombea says
Hi Lori,
You have to write the code you are using inside a loop that selects all sheets one at a time, like this:
Dim Wks as WorksheetFor Each Wks in Thisworkbook.Worksheets
Application.Goto wks.cells(1,1)
'you are now in that sheet, do what you need, use Wks.Name if you need the name of current sheet in your code...
Next Wks
Cheers,
Catalin
JJ says
Dear Sir
Please help to change the code so
I could have pdf created and attached in the email
and saved into the folder I want with name of the active sheet and save into the folder with the name of the active sheet and with yyyymmdd.
and with signature and body in the email at the same time,
as at the moment I only could get the signatures if I add .body the signature will dissapear.
Thank you.
sorry and also add the emails I want in the vba codes as well.
W
Catalin Bombea says
Hi,
You should know that we are not writing custom codes, we can only give you indications to write your own code.
Check this file from our OneDrive folder, you will find there a method to add the signature back. The code has some comments, like:
.Display 'when an empty email is attached, the signature is automatically inserted, we can copy it...Sig = OutMail.HTMLbody 'get the signature, we will insert it later, at the end of the new body message
.Subject = "test"
.HTMLbody = RangetoHTML(rng) & Sig 'insert the signature after the new message body
If you read the comments too, the problem was already solved.
Let us know if you get stucked.
Cheers,
Catalin
Rob Rinne says
This is truly wonderful for a complete amateur like me.
I would like to ask, though, for line 24, how can I use this code to email to a range of email addresses?
Any help would be greatly appreciated.
And maybe a point in the right direction as to what I can do to learn more Excell-Fu
Philip Treacy says
Hi Rob,
Glad that you found this useful 🙂
If you want to email to more than 1 person you can do it a couple of different ways.
Option 1
In the code you can specify a list of email addresses, separated by commas like so :
You can specify the Email_CC and Email_BCC email addresses in a similar way.
Option 2
Change Email_To to refer to a cell on the current sheet, and in that cell put your comma separated list of email addresses.
Email_To = ActiveSheet.Range("H1")So whatever is in H1 will be the list of addresses that get emailed.
Cheers
Phil
Christian says
Thanks! You are awesome by helping beginers like me with such graphical explanations.
Philip Treacy says
No worries Christian, glad we can help.
Regards
Phil
Jim Bristow says
VBA code: send current worksheet as PDF file from Excel
Can you help me?
I found this code which works wonderfully Automating sending workbook sheets as PDF’s thru Outlook. I am attempting to modify it to send multiple range names within workbooks as individual and multiple PDF’s as individual and multiple attachments thru Outlook to differing recipients.
Sub SendWorkSheetToPDF()
‘Update 20131209
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, “.”)
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex – 1)
FileName = FileName & “_” + ActiveSheet.Name & “.pdf”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject(“Outlook.Application”)
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = “skyyang@extendoffice.com”
.CC = “”
.BCC = “”
.Subject = “kte features”
.Body = “Please check and read this document.”
.Attachments.Add FileName
.Send
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Note: In the above code, you can change the following information to your need.
.To = “skyyang@extendoffice.com”
.CC = “”
.BCC = “”
.Subject = “kte features”
.Body = “Please check and read this document.”
Catalin Bombea says
Hi Jim,
You ca add multiple files as attachments like this:
‘add multiple files, using separate lines for each file
.Attachments.Add currentfile
.Attachments.Add currentfile
‘or use a loop:
For i = 0 To 3
.Attachments.Add currentfile
Next
‘ instead of current file, which is the same in this example, you can use _
an array with files path: (create the array first, or use a range of cells) _
For i = 0 To 3 ‘ we start from 0 because first array item number is 0 _
.Attachments.Add ArrFilepath(i) _
Next
To add a range of cells to email body, select the range, then your code should have this lines:
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Instead of .Body, use:
.HTMLBody = RangetoHTML(rng)
And this is the RangetoHTML function used :
Function RangetoHTML(rng As Range)Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to paste the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).PasteSpecial xlPasteColumnWidths, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
You can also test a file from our OneDrive folder, with a functional example.
Hope it helps 🙂
Catalin
Laura says
Hi please can you help me, i have the following code, which saves the sheet to pdf and creates a new blank invoice which is perfect, i used a square shape, now i want another shape to have a code that “saves and emails” that pdf to the client, the clients email address is on line I14, the subject line must say Invoice- (inv number)
Subject must be ” Dear (client name- I12),
Please find attached herewith your invoice number (J5)
Kind regards….
Sub NextInvoice()
Range(“J5”).Value = Range(“J5”).Value + 1
Range(“B21:C42”).ClearContents
Range(“I21:J42”).ClearContents
Range(“I12:K12”).ClearContents
End Sub
Sub SaveInvWithNewName()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
“F:\Writting\EXTRA WORK\AVON\INVOICES\INV0” & Range(“J5”).Value & “.PDF”, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
NextInvoice
End Sub
Catalin Bombea says
Hi Laura, try this code:
Sub EmailWithOutlook()Dim oApp As Object
Dim oMail As Object
Dim FilePath As String
Dim FileName As String
Application.ScreenUpdating = False
' create file name and path
FilePath = "Y:\" 'change the path as desired
FileName = FilePath & ActiveSheet.Name & ".pdf"
'Now Export the Activesheet as PDF with the given File Name and path
Sheets(ActiveSheet.Name).ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'Create and show the Outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = Range("I14").Text
.Subject = "Dear" & Range("I12").Text
.body = "Please find attached herewith your invoice number " & Range("J5").Text
.Attachments.Add FileName
.Display
End With
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
Laura says
Hi I managed to get all the codes i was looking for, but thank you so much for your help, i really appreciate it, I have 4 buttons on my invoice- Sales Log, Email to Client, Print, and Save and Clear, herewith are the codes for each respectively, hope it can help someone else. (The print code i wanted to print in colour as my default is blk and wht, so i recorded the code, and it works, I now just need the code to insert my email signature which is not a default signature (or a picture) which i have not figured out yet, here are the code:
Sub SALESLOG()
Dim i As Long, j As Long, lr As Long
lr = Sheets(“Invoices”).Cells(43, “B”).End(xlUp).Row
With Sheets(“NEW SALES ORDER 2014”).Range(“A1”)
i = .CurrentRegion.Rows.Count + 1
End With
With Sheets(“NEW SALES ORDER 2014”)
.Cells(i, “A”).Value = Sheets(“INVOICES”).Range(“F4”).Value
.Cells(i, “B”).Value = Sheets(“INVOICES”).Range(“J8”).Value
.Cells(i, “C”).Value = Sheets(“INVOICES”).Range(“J5”).Value
.Cells(i, “D”).Value = Sheets(“INVOICES”).Range(“H12”).Value
.Cells(i, “E”).Value = Sheets(“INVOICES”).Range(“J6”).Value
.Cells(i, “F”).Value = Sheets(“INVOICES”).Range(“H13”).Value
.Cells(i, “G”).Value = Sheets(“INVOICES”).Range(“H15”).Value
For j = 21 To lr
If j > 21 Then
.Cells(i – 1, “B”).Resize(, 6).Copy .Cells(i, “B”).Resize(, 6)
End If
.Cells(i, “H”).Value = Sheets(“INVOICES”).Range(“B” & j).Value
.Cells(i, “I”).Value = Sheets(“INVOICES”).Range(“C” & j).Value
.Cells(i, “J”).Value = Sheets(“INVOICES”).Range(“D” & j).Value
.Cells(i, “K”).Value = Sheets(“INVOICES”).Range(“I” & j).Value
.Cells(i, “L”).Value = Sheets(“INVOICES”).Range(“K” & j).Value
i = i + 1
Next j
End With
End Sub
______________________________________________________________________
Sub Emailtoclient()
strPath = Environ$(“temp”) & “\”
strFName = ActiveSheet.Range(“I12”)
strFName = Range(“J5”) & “-” & ActiveSheet.Range(“H12”) & “.pdf”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject(“Outlook.Application”)
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = Range(“H14”).Value
.CC = “”
.BCC = “”
.Subject = “Avon invoice” & “-” & Range(“J5”)
.Body = “Good Day” & ” ” & Range(“H12”) & “,” & vbCr & vbCr & “Thank you for your order in brochure” & ” ” & Range(“J8”) & vbCr & “Please find attached herewith your invoice” & “-” & Range(“J5”) & vbCr & vbCr & “Kind Regards” & vbCr & “Laura Graham” & vbCr & “Avon Germiston” & vbCr & “Telephone number” & vbCr & “email” & vbCr & “web address”
.Attachments.Add strPath & strFName
.SendUsingAccount = OutApp.Session.Accounts.Item(3)
.Display
End With
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
______________________________________________________________________
Sub Printinvoice()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub
_____________________________________________________________________
Sub Nextinvoice()
Range(“K5”).Value = Range(“K5”).Value + 1
Range(“B21:C42”).ClearContents
Range(“I21:J42”).ClearContents
Range(“H12:K12”).ClearContents
End Sub
Sub SaveAndClear()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
“F:\Writting\EXTRA WORK\AVON\INVOICES\” & Range(“J5”).Value & “-” & Range(“H12”).Value & “.pdf”, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Nextinvoice
End Sub
Catalin Bombea says
Hi Laura,
You can try to .Display the message before the lines with Subject and Body, this will add your default signature to the email (i hope you set one). Then you can store that signature, and add it to the end of your message body:
.DisplaySig = OutMail.HTMLbody 'get the signature, use Sig = OutMail.Body if it's just simple text
.Subject = "test"
.HTMLbody = "Bodytext here" & Sig 'insert the signature after message body
Hope it helps
Catalin
Birinder says
Thank you for this excellent code. It helped me a lot. Is it possible to add a e-mail address on the excel sheet so that e-mails goes out automatically with that pdf attachment?
Catalin Bombea says
Hi Birinder,
Change this code from line 24:
Email_To = "" change to: Email_To = ActiveSheet.Cells(1,"A").TextCatalin
Brian Douglas says
Philip, This is great I tell you my situation. I’ve used ron’s code to create mail through his HTML code. The problem I have is when it builds the email in HTML and sends the file (we have multiple files attached) and then IOS on IPhone will download as plain text which is a hassle to scroll down 50 emails to hit download rest of message and wait for it to reset so it is easily read on IPhone. If I Use same code w/ no attachments and looks perfect.
Now I would like to see if using your code and attaching a PDF of the Range on my sheet (a1:k46) can it then show the PDF in the body of the email—-
Catalin Bombea says
Hi Brian,
Instead of creating a PDF file from a range of cells, then attach it to the email, THEN show that PDF in email Body (which i don’t think it’s possible), why don’t you send the range directly to email body, in HTML format? Try:
Sub Send_Email()Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
'set here the range for email body
Set rng = ActiveSheet.Range("A1:K46").SpecialCells(xlCellTypeVisible)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "emailaddress@yahoo.com"
.Subject = "test"
.HTMLBody = RangetoHTML(rng)
.Display
'.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to paste the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).PasteSpecial xlPasteColumnWidths, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Catalin
Brian Douglas says
Thanks Catalin,
The problem with HTML as I said earlier is in IOS on Iphone once your attachments get to a certain size it is downloaded as plain text causing you to scroll all the way down to end and download the rest then the phone has to rest it self for it to come through correctly. We get on average 50+ reports in the AM which this has made the whole ordeal troubling.
Another way I have tried is I convert the entire file over to Image and then past that into outlook and when IOS downloads as plain text the image is still visible the problem with that is I can not get my default email signature to come thru. Would you be able to provide any help there.
I will paste my code but it is kind of long.
‘Looks to see if Outlook is open and If not open it
#Const LateBind = True
Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6
#If LateBind Then
Public Function OutlookApp( _
Optional WindowState As Long = olMinimized, _
Optional ReleaseIt As Boolean = False _
) As Object
Static o As Object
#Else
Public Function OutlookApp( _
Optional WindowState As Outlook.OlWindowState = olMinimized, _
Optional ReleaseIt As Boolean _
) As Outlook.Application
Static o As Outlook.Application
#End If
On Error GoTo ErrHandler
Select Case True
Case o Is Nothing, Len(o.Name) = 0
Set o = GetObject(, “Outlook.Application”)
If o.Explorers.Count = 0 Then
InitOutlook:
o.Session.GetDefaultFolder(olFolderInbox).Display
o.ActiveExplorer.WindowState = WindowState
End If
Case ReleaseIt
Set o = Nothing
End Select
Set OutlookApp = o
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case -2147352567
Set o = Nothing
Case 429, 462
Set o = GetOutlookApp()
If o Is Nothing Then
Err.Raise 429, “OutlookApp”, “Outlook Application does not appear to be installed.”
Else
Resume InitOutlook
End If
Case Else
MsgBox “Error ” & Err.Number & “: ” & Err.Description, vbCritical, “Unexpected error”
End Select
Resume ExitProc
Resume
End Function
#If LateBind Then
Private Function GetOutlookApp() As Object
#Else
Private Function GetOutlookApp() As Outlook.Application
#End If
On Error GoTo ErrHandler
Set GetOutlookApp = CreateObject(“Outlook.Application”)
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
Set GetOutlookApp = Nothing
End Select
Resume ExitProc
Resume
End Function
Sub sendMail()
‘Save morning report document in job folder As PDF
Dim MyPath As String
MyPath = ActiveWorkbook.Path & “\Morning Reports\”
ChDir MyPath
Sheets(“Morning Report”).Range(“A1:k46”).ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyPath & “\\Morning Report” & “_” & Format(Now(), “mm.dd.yy”) & “.PDF”, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim TempFilePath As String
‘Create a new Microsoft Outlook session
Set appOutlook = CreateObject(“outlook.application”)
‘create a new message
Set Message = appOutlook.CreateItem(olMailItem)
‘Message to confirm ready to email
RetVal = MsgBox(“ARE YOU SURE EVERYTHING IS CORRECT AND COMPLETED?”, vbYesNoCancel, “Confirm”)
Select Case RetVal
Case vbYes
Case vbNo
Exit Sub
Case vbCancel
Exit Sub
End Select
With Message
.Subject = Range(“c5″) & ” – ” & Range(“c6″) & ” – ” & Range(“c7″) & ” – ” & Range(“c8″) & ” County, ” & Range(“c9″) & ” – ” & Range(“c10″) & ” – ” & ” Morning Report ”
‘first we create the image as a JPG file
Call createJpg(“Morning Report”, “A1:k46”, “MorningReport”)
‘Then we add an html link to this image
.HTMLBody = “”
.To = “brian.douglas@gyrodata.com”
.Cc = “”
TempFilePath = Environ$(“temp”) & “\”
.Attachments.Add TempFilePath & “MorningReport.jpg”, olByValue, 0
.Attachments.Add ActiveWorkbook.FullName
.Attachments.Add MyPath & “\\Morning Report” & “_” & Format(Now(), “mm.dd.yy”) & “.PDF”
ThisWorkbook.Save
.Display
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Sub createJpg(MorningReport As String, nameRange As String, nameFile As String)
ActiveSheet.Unprotect Password:=”Financial3″
ThisWorkbook.Activate
Worksheets(“Morning Report”).Activate
Dim plage As Range
Set plage = ThisWorkbook.Worksheets(“Morning Report”).Range(“A1:k46”)
plage.CopyPicture
With ThisWorkbook.Worksheets(“Morning Report”).ChartObjects.Add(plage.Left, plage.Top, plage.Width, plage.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$(“temp”) & “\” & nameFile & “.jpg”, “JPG”
End With
Worksheets(“Morning Report”).ChartObjects(Worksheets(“Morning Report”).ChartObjects.Count).Delete
Set plage = Nothing
‘—————————————————-
‘Protect Sheet when done
‘—————————————————
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=”Financial3″
End Sub
Catalin Bombea says
Hi,
How about setting your signature in that image? Instead of A1:K46 range, use range A1:K50, use the last 4 rows to set a temporary signature.
Catalin
Brian Douglas says
Our default Sig: Has 10 lines and our logo at the bottom: How would your HTML add that into the bottom of the Body just by expanding the range in excel.
Catalin Bombea says
Well, i didn’t say HTML, you just said that HTML will not work. I meant to use your code you just posted above, paste your signature under that worksheet range, then , when creating the image, use an extended range to create the jpg file, to include the signature in that image.
If it’s not what you wanted, please upload to our Help Desk a sample file with your code, and more details. I understand that , when IOS downloads as plain text, your signature is lost, right? So HTML formatted signature cannot be used. Try that idea with adding the signature to the jpg file.
Catalin
Sharon Hickox says
Phil
Thanks for the above – does ‘nearly exactly’ what I want.
I would like to add a specific file name where you have
[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]
…and I cant seem to find the correct VBA…
I am sure the answer of obvious ….
rgds
Sharon
Philip Treacy says
Hi Sharon,
Do you want to specify a different filename each time, or use the same filename?
Phil
Sharon Hickox says
Phil
Same folder but differing file names dependant on worksheet name eg:
“G:\Sharon\Develop\Marketing”
“G:\Sharon\Develop\Operations”
Catalin Bombea says
Hi Sharon,
As you already noticed, it’s a simple change you have to make:
DestFolder is declared as a string type, all you have to do is to replace:
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 WithReplace above code with:
Or, you may set a cell in a worksheet to type the address (better with a data validation selection), this way you dont have to change the address in code:
DestFolder =Sheets("Sheet1").Cells(1,"B").TextAnother option is to create a simple user form with a combobox that will allow you to select a folder from the drop down list.
Catalin
Sharon Hickox says
Thanks
Got it working fine
Catalin Bombea says
You’re wellcome Sharon 🙂
Catalin
Nitin says
Thanks Phil
I just downloaded your sheet & tried running it as it is but it came with error ” Complie Error ” ” Variable not defined” & it is highlighting the code xltypePDF when it is converting into PDF.
Why it coming so
Kindly help so I amend it as per my wise.
Philip Treacy says
Hi Nitin,
what version of Excel are you using? If it’s 2007 you may need to install the Save as PDF or XPS add-in from Microsoft.
If that doesn’t fix the issue please open a Help Desk ticket and send me your file.
Regards
Phil
Rachael says
I’m getting a Run-Time error ’52’ Bad file name or number on
If Len(Dir(PDFFile)) > 0 Then
Thanks,
Rachael
Philip Treacy says
Hi Rachael,
I’m guessing there’s a problem with the PDFFile name, but I could only tell you if I can see all of your code.
Can you please open a ticket on the Helpdesk and attach the file.
Regards
Phil
Tony says
Hi Phil,
Fantastic blog and very helpful – thank you so much.
Very clear to understand and it has saved me hours
Philip Treacy says
You’re most welcome Tony. Thanks for the question which lead to this post.
Regards
Phil