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.
Show Me The Code!
Enter your email address below to download the sample workbook.
Here it is. Download the VBA code in an Excel workbook,
or as a text file
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.
Hi This code works great for me for what i want to use it for. I have a number of sheets that have different e-mails where i want them to go which works perfectly. However i have a number of sheets that i do not want to send out and the only way i can get this to work is that it sends all the sheets in pdf format then because on the remaining sheets i don’t want to send out don’t have an email they just turn into a PDF attach to the email and i have to close them all without sending. is there a way i can edit this so it only sends the selected sheets that i want?
Sorry if this has been asked before!
Hi Richard,
You have to test the email address before creating the email object.
If you’re using this code to send all sheets, you can check the email address before sending:
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
if Len(ws.Range(“A1”).Value)>0 then create_and_email_pdf ‘make sure email cell is not empty
Next
End Sub
Or make a list of sheets to ignore:
Dim SheetsToIgnore as string: SheetsToIgnore = “Sheet1, Sheet2, Sheet3”
if Instr(1, SheetsToIgnore, ws.Name, vbTextCompare)=0 then create_and_email_pdf
Hello Admin,
I have Create a Active Sheet With Name PaySlip and H1 = EMP Code in Drop down list. Also Crate a Send button to Send Entire PaySlip as PDF.
If I Select any EMP Code from drop down and click send button then it’s send perfectly.
So, I have to select every time emp. code from list and then send, it’s required lots of time becz of 2000+Employees and most important it’s may be chance to human error in selection drop down every time.
Is there any way to automatically save that PDF at desire location and send it in a single clicks to all different payslip to different employees.
Hi Dev,
I don’t think I fully understand. You want to send the same payslip to everyone? Or you have a number of different payslips to send to people who have the same EMP Code? Won’t all payslips be different/unique to the employee?
Either way, we need to see your code to be able to offer anything other than general advice. Without your workbook and code we can’t help much. Please start a topic on our forum and attach your file.
Regards
Phil
Hello,
Thanks for the code.
I was also thinking of asking for help.
How can I enter this code, in a button.
I want when I click on the button to send me the email with the excel sheet attached.
Thank you
Salut Dan,
Here is an article that will help you:
https://www.myonlinetraininghub.com/assign-a-macro-to-a-shape-or-use-a-shortcut-sequence
Cheers,
Catalin
Salut Catalin.
Iti multumesc frumos. Totul functioneaza asa cum am dorit.
Multe salutari
Salut Catalin,
Pe un alt calculator intalnesc urmatoarea eroare:
“Run-time error 1004:
Document not saved. The document may be open, or an error may have been encountered when saving.”
Am buton cu optiunea “End”, “Debug” sau “Help”
Daca aleg “Debug” ma pozitioneaza pe. linia de cod:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
Ma poti ajuta in rezolvarea acestei situatii?
Multumesc frumos
Mai intai verifica sa nu fie deja un PDF cu acelasi nume deschis, aplicatia nu poate salva un fisier cu acelasi nume in aceeasi locatie daca e deschis.
Poate fi si o eroare de FilePath daca fisierul este in OneDrive, in aceasta locatie ThisWorkbook.Path returneaza un URl de genul “https://…”
Salut Catalin
te poi gandi la implementarea unui cod de trimitere a fisierului in format .pdf, direct pe whattsapp?
Multumesc
Sunt ceva coduri pentru whatsapp: https://stackoverflow.com/questions/62371366/send-a-pic-from-excel-via-whatsapp
Ai aici instructiuni pentru instalare Selenium: https://www.myonlinetraininghub.com/web-scraping-filling-forms
Sugerez sa deschizi un subiect nou pe forum.
Salut Catalin,
am verificat si nu am nici un fisier .pdf, deschis, cu acelasi nume.
Nu stiu ce sa-i fac. Mi se opreste la linia: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating”
Pe alt calculator functioneaza perfect.
Poti sa iti apleci putin atentia in rezolvarea acestei erori?
Multumesc mult
Ce versiune de office este pe acel calculator?
Unde este salvat fisierul care contine acest cod? Cand apare eroarea, apasa Debug, apoi Ctrl+G ca sa afisezi Immediate Window in VB Editor (in cazul in care nu este afisat), apoi tasteaza in Immediate Window :
?PDFFile si apasa Enter.
Ar trebui sa imprime calea de salvare a fisierului.
Posteaza calea generata de cod, sa vedem daca este corecta.
Versiunea Excel este :
Microsoft® Excel® 2016 MSO (Version 2202 Build 16.0.14931.20118) 32-bit
Fisierul Excel, se numeste “Oferta” si este pe Desktop.
Calea returnata de comanda ?PDFFile, in fereastra ImmediateWindow este:
“C:\Users\Dan Cretu\Desktop\Oferta_3/21/2022.pdf
“C:\Users\Dan Cretu\Desktop\Oferta_3/21/2022.pdf
nu este o denumire valida de fisier. Numele unui fisier nu poate contine “/”.
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & Format(CurrentMonth,”dd-mm-yyyy”) & “.pdf”
Eu am mai introdus in codul tau, Dim Oferta As String, aici :
Dim EmailSubject As String, EmailSignature As String
Dim Oferta 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 = “”
si aici:
EmailSubject = ActiveSheet.Range(“L2”).Value ‘Change this to change the subject of the email. The current month is added to end of subj line
Oferta = ActiveSheet.Range(“E4”).Value
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 = ActiveSheet.Range(“L3”) ‘Change this if you want to specify To email e.g. ActiveSheet.Range(“H1”) to get email from cell H1
Email_CC = “”
Email_BCC = “”
iar aici, am lasat la fel:
‘Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & CurrentMonth & “.pdf”
Salutations Phil,
I’m pretty sure your code is similar to what I currently use. It’s worked pretty well up until now. my company has migrated its network all to the SharePoint cloud network. specifically the part below doesn’t work. Any ideas on how to correct it?
‘If the PDF already exist
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
Hi Joshua,
How exactly does it not work? Are you getting errors? Which bit causes the error?
Are you trying to delete a file on Sharepoint?
Regards
Phil
1) Lets say I have multiple sheets I want this macro to work for, but each sheet is designated to send to a different email addresses. How do I do that?
2) How do I automatically place an email body description in the email?
Sorry, I am not too familiar with this.
Hi Carlos,
You use a loop to go through each sheet in turn. Without seeing your workbook though I can’t be sure that what I’d write would work for you.
At the top of the code there’s a section headed ‘ ***** You Can Change These Variables ********* and in there is one called Email_To. Change this to pick up the email address you’re sending to. For example to send to an email address stored in cell H1 you’d write Email_To = Range(“H1”).Value
To add some body text add this line to With.OutlookMail
.body = “Some text.” & vbNewLine & vbNewLine & “A 2nd line of text.”
and modify the text as desired.
If you want to post your question on our forum and attach your workbook I can look at writing the loop for you.
Regards
Phil
Hi Phil,
I am having the same issue. I am trying Worksheets(Array(“barnett”, “cardullias”)).Range(“E1”)
This is giving me an error, “‘438’ Object doesn’t support this property or method. Barnett and Cardullias are the sheet names. I need to add many more as well.
Hi Dennis,
My guess you’re trying to send more than 1 sheet, each to different recipients.
See this post for how to send all sheets:
https://www.myonlinetraininghub.com/excel-forum/vba-macros/vba-excel-loop-and-directory#p19799
There is a code there: SendAllSheets, copy that code in the same module where you have your code.
Run this code, will send all sheets.
Thanks for this article/this site!
I am hoping to set the PDF destination to be a Sharepoint Server. I followed the steps to ‘ out the With .. End With portion of the ‘Prompt for file destination’ code; and then attempted DestFolder=”https.sharepoint….” but that was wishful on my part. Any advice on how to set this up?
and by server I mean a Folder on my team’s Sharepoint site.
Try:
Dim fs as Object: Set FS = CreateObject(“Scripting.FileSystemObject”)
FS.CopyFile “C:\LocalFile.pdf”, “\\sharepoint.path\library\” ‘ use UNC path, not https://…
Hmm that didn’t do the trick, but I am a total VBA novice and so may have laid things out incorrectly or been unaware of some back-end tasks that would come naturally to you, Catalin.
Hi Patrick,
Please upload a sample file with your code on our forum (create a new topic after sign in), it’s the best place to get help.
Hard to see what does not work without seeing what you did. Impossible in fact.
See you on forum
Cheers,
Catalin
Hi … would love to know how to choose which email account to send from as default, as I have several configured in Outlook.
Thanks,
Roddy
Hi Roddy,
There’s a few steps:
1. Declare a variable Dim OutlookAccount As Object
2. Set the value Set OutlookAccount = OutlookApp.Application.Session.Accounts.Item(“[email protected]”)
3. Change the Sending Account Set .SendUsingAccount = OutlookAccount
Step 3 is done inside the With OutlookMail section.
Regards
Phil
Hi again … at step 2 I get a compile error [ Expected: list separator or ) ] and it highlights the portion of the email address after the @.
Suggestions?
Thanks,
Roddy
Hi Roddy,
I need to see the code to debug it. Please start a topic on the forum and attach your file.
Regards
Phil
Hi … thanks for this. I’ve made good use of it and it works really well.
I’d like to avoid having to select a folder to save the PDF in – I always save them to the same folder, but I can’t figure out how to alter the code to do that. Suggestions?
Thanks,
Roddy
Hi Roddy,
You need to do 2 things:
1. Comment out the With … End With section under the heading ‘Prompt for file destination
2. Set DestFolder to the name of the folder you want to save to e.g. DestFolder = “C:\temp”
Regards
Phil
I am trying to the same thing but by commenting out the With and End with lines I keep getting Compile errors as if. show is the first code it sees. Is there another line that needs adjusting?
Hi Kyle,
You need to comment out the whole section between With and End With, not just those 2 lines.
Then add a line to give DestFolder a value e.g. DestFolder = “C:\temp”
Regards
Phil
Hi. hope all is safe at home regarding this lockdown time.
Thank you so much for this code. it helped me so much.
I may be doing something very stupid.
1 thing I cant get around is having my active x control button do the work.
I seem to only be able to achieve the code by running it.
Hi Ronn,
Without seeing your workbook I couldn’t say what the issue is. Please start a topic on the forum and attach your workbook.
Regards
Phil
Is there a way I can make it make a PDF of only a range of cells of a sheet?
Hi Chaylon,
Try:
ActiveSheet.Range(“A1:M50”).ExportAsFixedFormat[…] instead of ActiveSheet.ExportAsFixedFormat[…]
It doesn’t work for me. I get syntax error :S
Can you help?
Thanks
Hi Jack,
Please upload a sample file with your code to see where it fails.
Use our forum for upload, create a new topic after sign-up.
Dear Catalin,
Mistery solved. Doing a copy-paste from your code to my excel would transform the character ” (double quote) into ” (not sure how to call it) that would cause the macro to stumble and fail.
Everything flows fine now except the fact that the macro takes up a strangely long time to run. I wanna find out why.
Thanks for your code
I stumbled upon your code on helping me email my invoices. I am try to use my existing code to send invoices instead of printing them. But my code put them all in one pdf instead of one for each sheet. I saw another code below that could be easier to go off of.
SO I have three questions;
1.I was trying to use it to select certain sheets with a value >18 in a certain cell.
2. But also wanted to differentiate a certain value in the cell that would just do the customers that wanted them emailed. or I could do an and condition after the first question.
3. Lastly, I was trying to figure out instead of having the prompt in the create_and_email_pdf can I tell it a certain place to save without the prompt? Where would I do it in the code?
Thanks,
Zach
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
code I originally used;
Sub Print_All_Worksheets_With_Value_In_H38()
Dim Sh As Worksheet
Dim Arr() As String
Dim N As Integer
N = 0
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = xlSheetVisible And Sh.Range(“h38”).Value > 18 Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = Sh.Name
End If
Next
With ActiveWorkbook
.Worksheets(Arr).PrintOut
End With
End Sub
Hi Zach,
For the first 2 questions, you can modify this part:
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
If ActiveSheet.Range("H38")>10 AND Condition2=True then Print_Worksheet
Next
End Sub
To print as PDF:
Sub Print_Worksheet()
Dim PDFFile as string
PDFFile = thisworkbook.Path & Application.PathSeparator & activesheet.name & ".pdf"
'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End Sub
If you want the PDF’s attached to email, use the code we provided in this article.
Catalin,
Thank you, for you help. Sorry i have so many questions.
On the code:
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
If ActiveSheet.Range(“H38”)>10 AND Condition2=True then Print_Worksheet
Next
End Sub
I was trying to get it to get it to send each sheet individually instead a one;
For example if I have the sheets based on letters and a, c and e had the right values then it would send customer a,c and e’s invoices out separately to there emails.
and on the other I was trying to get it to save the pdf automatically without prompt. Do I change the code “DestFolder & Application.” to the specific file name?
‘Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & CurrentMonth & “.pdf”
As mentioned, if you want to attach the pdf’s to emails, use the code provided in this article, not yours. Your sample code provided just prints pdf’s, it’s not creating emails.
File name can be:
PDFFile = “C:\PDFFiles Folder” & Application.PathSeparator & ActiveSheet.Name & “.pdf”
or: PDFFile = thisworkbook.path & Application.PathSeparator & ActiveSheet.Name & “.pdf”
As you can see, the file name will be the sheet name.
See this topic on our forum.
Please create a new topic and upload a sample file, it will be easier to help you with a functional file.
Hi, thanks for this wonderful code.
Actually I have no idea about coding. I just copied your code and I am trying to customise it for my needs,
I am however running into issues with the code. Logical.
I would like the the created PDF file to get its name from a cell value, and then proceed with saving the file and attaching it into Outlook.
Kindly help out. How do i do that?
Hi Joseph,
Instead of:
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “-” & CurrentMonth & “.pdf”
Use:
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range(“H5”) _
& “-” & CurrentMonth & “.pdf”
Change from H5 to your desired cell with file name in it.
Hello, need help please with VBA. Consider that I’m new to this. I’m after a VBA code that does below separately:
OPTION 1 – User will access an excel file from Sharepoint and fill in required information.
OPTION 2 – Multiple users have the excel file saved on their PC and fill in required information. VBA should be able to local the file on a user’s PC.
In both options:
– Click on Submit button in excel file
– File is attached to an email which is opened for editing by user
– Email shows a defined email address to send to
Many thanks in advance.
Also, great site and host of information which I find very useful always.
Hi Monish,
Storing the file on Sharepoint and sharing to multiple people will be done in your Sharepoint/Office365 admin – it doesn’t involve any VBA at this point.
To do the rest : click a button, attach the file and email it, this code does all of that already. Have you tried it and had some problems? If so can you please start a topic on the forum and supply the code/workbook you are working with.
Regards
Phil
How would i go about just sending the pdf and skipping the stage of saving it as i am not interested in that?
Hi Joe,
You can’t skip saving the pdf. No attachment can be added, manually or programmatically, without providing the path to the file.
Great code, but I have 2 questions.
1. How do you automatically save the file in the current folder? Disabling the prompt to select a folder?
2. How do you automatically send the email with out prompting a click on the send button?
I have solved both problems 🙂
Nice job, good to hear you managed to solve the problems!
Catalin
How did you do it ?
I see that this code can be used to go thru all sheets. Where exactly in the code should this be inserted?
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
Hi Karla,
It’s a different procedure, should not be placed in the other code. Place it above the starting line of the existing code: Sub create_and_email_pdf()
Sub SendAllSheets()
”’
”’
End Sub
Sub create_and_email_pdf()
”’
”’
End Sub
Hello – I added the info above to the top but now the macro stops on line: ‘Create the PDF and gives Run-timer error ‘5’ invalid procedure call or argument. I appreciate your help!
Option Explicit
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
Sub create_and_email_pdf()
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 = “July 2019”
EmailSubject = “Effort Reporting”
OpenPDFAfterCreating = False
AlwaysOverwritePDF = False
DisplayEmail = True
Email_To = ActiveSheet.Range(“H1”)
Email_CC = “”
Email_BCC = “”
‘Prompt for file destination
DestFolder = “U:\Personal”
‘Current month/year
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
The file name might be in a wrong format.
You should add a new line in code to display the file name:
(add the following line before the line that is raising the error)
Msgbox PDFFile
I cannot get the code to run when I try to pick up the date from a date formatted cell for example
07 March 2019
I get error :
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
Also can I set a default temporary save folder that does not require confirmation every time I run the macro
Many thanks Sean
Hi Sean,
Without seeing your code I cant say what is going wrong, but it’s probably to do with the FileName. What is the value of PDFFile? You can step through the code or put a breakpoint in to stop the code execution before the PDF is created, and then check what PDFFile is. Is it a valid filename? You can read up on debugging VBA here:
https://www.myonlinetraininghub.com/debugging-vba-code
https://www.myonlinetraininghub.com/more-tips-for-debugging-vba
Yes, you can sset a default save folder, I’ve answered that here:
https://www.myonlinetraininghub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook#comment-64869
Regards
Phil
Hi
If i want to use the same process but not for sheets, i want it to create a PDF file for data in a Table and use the name cell as the Pdf file name.
Can this be done?
I’m not expert in VBA
Hi,
You will have to upload a sample file on our forum so we can see your data structure. Here is a link, create a new topic after sign-up.
Hello,
I am stuck. I currently have it set up to run the macro through all sheets, but would to like to exclude some sheets and haven’t been able to get it to work. I keep getting an error when i use the examples listed in the comments here, so i imagine i am making the error. Can anyone make a suggestion to help figure out what i am doing wrong?
Here’s what i have to run the code through all sheets
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
Hi Jay,
Your code runs without an error for me so without the workbook you are using I can’t properly debug it.
To exclude sheets you could use a couple of ways. Use a list of sheet names and test the active sheet name then skip over that sheet, or use a value in a cell on the sheet to indicate to exclude it.
Here’s your rewritten sub that uses the first method
Sub SendAllSheets() Dim ws As Worksheet Dim Exclude As String, DestFolder As String Exclude = "Woody,Range Names" '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 For Each ws In Worksheets If InStr(Exclude, ws.Name) < 1 Then ws.Activate create_and_email_pdf (DestFolder) End If Next End SubThis also requires modification of the main emailing sub, you can find all the code here Exclude Sheets
I've moved the prompt for the destination folder into the sub above so that the user is only asked once for this.
To test a cell on the sheet to see if the sheet should be excluded you could modify the sub above to
For Each ws In Worksheets ws.Activate If ActiveSheet.Range("A1").Value <> "X" Then create_and_email_pdf (DestFolder) End If Nextregards
Phil
Hello. I’d like to be able to do this, but have the document presented to the recipient without them having to download the attachment and open it (especially handy if on a mobile device). Is there a way to create the .pdf and embed it as the body of the email itself? Thanks !
Hi John,
You might be able to use a code similar to: https://stackoverflow.com/questions/44598984/how-to-embed-a-pdf-document-in-an-email-message
The only problem is that you need to have Adobe Acrobat Pro to run this code, this interface is in the Acrobat SDK only, not Adobe Reader.
hi is there a way for me to save the file name based on vlookup value on
B8 combined with AC8 ? both of this value is from vlookup value. can the marco help to delete those text like / cause it cant be saved as pdf?
and the subject line on email also on B8 and send this email on B9 with another vlookup value?
is this possible? thanks alot!
Hi Nelson,
Follow the instructions in this page and adjust the code with your parameters:
‘Current month/year stored in H6 (this is a merged cell)
CurrentMonth = ActiveSheet.Range(“B8”).Value & ActiveSheet.Range(“AC8”).Value
‘Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & CurrentMonth & “.pdf”
For Subject, Email To parameters, you have also instructions in this page and in cde:
EmailSubject = "Invoice Attached for " 'Change this to change the subject of the email. The current month is added to end of subj line
Email_To = "" 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
Change them to fit your needs:
EmailSubject = ActiveSheet.Range("B8").Value
Email_To = ActiveSheet.Range("B9").Value
Hi,Catalin Bombea
thanks alot!! it is working as intended
I am receiving an error message:
Run-Time Error ’91’:
Object variable or With block variable not set.
I don’t know why that is, I am copying and pasting exactly as it is written
If. Show = True Then
at top is what is highlighted with I debug a
Hi Kim,
we will need more information. What version of excel are you using, and what’s your operating system?
Can you upload a sample file on our forum?
muy buena macro
Gracias 🙂
This is great. a question.
How can I send the email from a common email like [email protected] or [email protected] instead of my personal email?
This is to overcome if a staff member leaves and the customer replies to the email of the staff who by then have left the business.
Hi Abdy,
You can send emails from any computer using the same email with CDO, see samples here.
Hi Catalin
I wish to do the same as Abdy but don’t understand the CDO sample. Is there just a way to put a line of VBA code to pick which email address it sends from?
Thanks
.sentonbehalfofname seems to have worked
Sarah
Hi Sarah,
CDO is used to send emails without Outlook.
SentOnBehalfOfName is still using outlook for sending.
If you have multiple accounts set oon your computer, set the account:
Set OutAccount = OutApp.Session.Accounts(“[email protected]”)
then use:
.SendUsingAccount = OutAccount
Hi,
Is there any code to insert the pdf copy in to an excel worksheet based on the invoice numbers from sharedrive.
Thanks.
What do you mean? You cannot insert a “pdf copy” into an excel sheet, maybe just as an object. Sharedrive does not sound right: is it onedrive, google drive, dropbox, sync?
Try our forum, you can upload there sample files.
After clicking on Create PDF and email, its showing the following error:
Run Time Error – 2147467259 (80004005)
Can you please help out in knowing what to do next in debugging?
Thanks in advance!
Well, just as you said, the next step is to press the Debug button, that will highlight the line of code that fails.
Try reading through these for tips on debugging
https://www.myonlinetraininghub.com/debugging-vba-code
https://www.myonlinetraininghub.com/more-tips-for-debugging-vba
Regards
Phil
Hi there!
I am building an interactive checklist on excel and I have already created a button where someone can click it and an email will send with the recipient, subject line and body already filled out. The issue I am having is to be able to insert the completed excel sheet into that buttons code so that when the recipient receives the email, they also receive a copy of the sheet. Can you help me understand what I need to do to accomplish this?
Hi Brandon,You have to save the sheet in a new workbook that will be attached to that email.
Will be something like this:
Dim SourceSheet as Worksheet: Set SourceSheet=ActiveSheet
Dim Wb as Workbook: Set Wb=Workbooks.Add
Dim NewFilePath as String: NewFilePath=ThisWorkbook.Path
SourceSheet.Copy Wb.Worksheets(1)
Wb.SaveAs NewFilePath & Application.PathSeparator & "FileName.xlsx", FileFormat:=51
Wb.Close True
Now, you can add another attachment to that email using the path to the new file:
.Attachments.Add NewFilePath & Application.PathSeparator & “FileName.xlsx”
Hello,
Thank you so much for the code!
I have gotten stuck. I have my code set up so that it will repeat the email PDF code for every sheet in the workbook; however, it prompts be for a save location for every single sheet. I am dealing with over 100 sheets and don’t have the time to select a save location. Is there a code to have it automatically save them all in the same folder?
Thanks so much for your help!
Hi Katie,
Remove these lines
and insert this
NOTE: you must replace C:\MyFolder with the full drive\path to the folder you want the files saved in.
Regards
Phil
How do you change that code so that you do not need to know the full file name? For example, if I send my workbook for others to use, each will be using a different location to store their folders, and each computer is “named” individually, causing errors in the path.
Thank you in advance!
Hi Loren,
Use ThisWorkbook.Path, this will identify the location of the workbook where the code resides, no matter where it’s saved.
Thank you! This works perfectly!
Hi there,
I am stuck..
I am trying to find the code to save a sheet as a PDF based off of 3 cell names G3,H3 & I3.
I need to add a button that allows me to save the sheet as a pdf and then another button that will allow me to email it through excel.
also if there is a code for 1 button that will allow me to do both.
have it save as a pdf with cells G3,H3 & I3 as the name to a folder on my desktop and then allow me to email right after saving.
My desktop location for this is /Users/arielsackett/Desktop/Purchase Orders
But i am currently using a mac to develop that sheet but will be transferring it to our company’s server that runs on Windows.
ANY AND ALL HELP IS APPRECIATED! THANK YOU
Also I am very new to this and learning my way through excel
Hi Ariel,
Try this https://d13ot9o61jdzpp.cloudfront.net/files/ariel.xlsm
You will need to edit the VBA to enter things like who you are sending the email to, the email subject etc.
If you need any more help please open a topic on the forum.
Regards
Phil
How would I add in to sendallsheets but also exclude specific sheets?
Sub Auto_Open()
SendAllSheets
Dim ExcludeList As String
ExcludeList = “ZAGG V5 INPUT, ZAGG ZEN INPUT, OWLET V5 INPUT, OWLET ZEN INPUT, TRAEGER V5 INPUT”
If InStr(ExcludeList, Sheet.Name) > 0 Then
MsgBox “This sheet will not be printed”
End If
End Sub
Hi Robert,
Dim ExcludeList As String
ExcludeList = “ZAGG V5 INPUT, ZAGG ZEN INPUT, OWLET V5 INPUT, OWLET ZEN INPUT, TRAEGER V5 INPUT”
The following code should be inside the loop through sheets from SendAllSeets procedure:
If InStr(ExcludeList, Sheet.Name) > 0 Then
MsgBox “This sheet will not be printed”
End If
I feel like im getting close to having this work how we need it to.
I have send all sheets in plus the exclude list but I dont know why the exclude list isnt working how it should. Can I get some help with the syntax/writing of it?
Would also like to know how I can get the following to work so whenever the file is opened the macro runs:
Sub Auto_Open()
MsgBox “Excellen” ‘Replace this with your macro code!
End Sub
________________________________________________________________________
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
Sub create_and_email_pdf()
ActiveSheet.EnableCalculation = True
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 = “”
Dim ExcludeList As String
ExcludeList = “ZAGG V5 INPUT, ZAGG ZEN INPUT, OWLET V5 INPUT, OWLET ZEN INPUT, TRAEGER V5 INPUT”
If InStr(ExcludeList, Sheet.Name) > 0 Then
MsgBox “This sheet will not be printed”
End If
EmailSubject = ActiveSheet.Range(“A1”)
OpenPDFAfterCreating = False
AlwaysOverwritePDF = True
DisplayEmail = False
Email_To = “[email protected]”
Email_CC = “[email protected]”
Email_BCC = “[email protected]”
DestFolder = “C:\DailyWfmPDF”
CurrentMonth = ActiveSheet.Range(“A2”)
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range(“A1”) & “.pdf”
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 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
Hi Robert,
That’s easy, just do what the instruction says:
Sub Auto_Open()
SendAllSheets
End Sub
The current workbook im in has 5 different sheets. I would like for each sheet to be saved as a pdf and then all 5 sent as images in the body of the email in 1 daily email. Can i get some help with this? Im really new to VBA
Hi Robert,
Please take a look at this topic, it has codes for sending all sheets to mail and save as pdf.
Saving as image needs a different approach, open a new topic on our forum with your stuation, we’ll help you.
Regards,
Catalin
Hi Sir
I would like to automate “Clicking the slicer”, which would update the 7 charts in my dashboard, because the slicer is connected to the 7 pivot tables. Once we automate it to go through all the listed items in the slicer once by one, the click event should create a .pdf file of predefined selection (Charts) and once we through with all the items in the slicer, the .pdf files should be combined in 1 pdf and emailed.
Can we do it?
Hi Amol,
Please open a topic on the forum and supply your workbook. Without your workbook it’s too difficult to give you a solution.
Regards
Phil
Thank you so much for this code!!! I do have a couple questions. I have got everything set up how Id like it however when the PDF is emailed the content is very large. Is there a way to change this or only send an email with information from cells with data in email?
Hi Robert,
Yes, you can build the message body with data from sheet using html formatting elements, you have here some details and a live try it editor.
If you need help on that, start a new topic on our forum.
Cheers,Catalin
Hi, I am saving an excel worksheet as a .pdf and I want to email the .pdf. The .pdf will be saved each day using the current date. How do I get the .pdf to email the most current file for the day. Say I’m saving as 02-07-19.pdf, 02-08-19.pdf, etc. How do I determine a specific file date to email daily. All my codes work except for the .Attachments.Add line.
Thanks!
Hi Gina,
First, the day format you use in file names does not have the best format, will cause wrong sorting in folder, because File-01-01-19.pdf will not be under File-31-12-18.pdf for example. Use: Format(Date,”yyyy-mm-dd”), the files will be sorted properly in folder. Second problem: using 2 digit year like 19 is confusing. Is it 2019, or 2119, or 2219? Excel will fail on this one.
Try this:
Dim FSO as Object, FileObject as Object, MaxDateFile as string, FileDate as long, CurrentFileDate as long
Set FSO=CreateObject(“scripting.filesystemobject”)
For Each FileObject in FSO.GetFolder(“put here your folder path”).Files
CurrentFileDate=CLng(CDate(Replace(Right(FileObject.Name,14),”.pdf”,””))) ‘ assuming that the file name will have a 10 digits date format (2019-02-07) and the .pdf extension
If CurrentFileDate>FileDate Then
FileDate=CurrentFileDate
MaxDateFile=FileObject.Path
End If
Next
This loop will produce the address of the latest file in that folder. If there are other files that pdf files, or if the date format is wrong or missing in the file name, will fail, file naming consistency is required.
Hi, I am new to this VBA code, however I managed to create an excel user form from looking google comments.
I have 2 questions:
1. I created a sheet2 within my workbook to create my shape which is my landing shape for anyone who needs to submit the user form on the web, how can I make this sheet as my landing page and just show the shape that has this ” click here to complete” and not show the excel application on the background.
2. I created a separate sheet to house my temporary data that is being populated for emailing the PDF submission, however when this sheet is hidden, my code does not work, how can I get this sheet hidden always but make the code work to create the PDF attachment and for the email to work.
thank you in advance for the help!!
Hi Marilyn,
Please start a topic on the forum and supply your workbook + code. Without these it’s impossible to debug and give you a response.
Regards
Phil
Hi there,
Thanks so much for this code!
How do I get the pdf file name to be saved as the users name which they would have stated in cell D5 .
Also, I have amended this code slightly so that the code runs only when users click a commandbutton (called “save form”).
How do I insert a message box into this code which prompts people to answer any blank boxes before it proceeds to save and email the file, when the commandbutton is clicked?
Many thanks in advance!
Kind regards,
PJ
Hi Phoebe,
Use this to take the file name from sheet, cell H5 (change as needed):
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Cells(5,”H”).Value & “.pdf”
To check if a cell is empty, use:
If Len(ActiveSheet.Cells(5,”H”).Value)=0 then
msgbox “Fill cell H5!”
Exit Sub
End if
Hi there,
Thank you for providing this.
I am trying to save an excel spreadsheet as a PDF, while naming the document based on cell contents of the excel document. Then I want to attach that PDF to an email, and reference an email look up list to send that email to.
This reference workbook would be dynamic and allow for us to change the customer email information and assigned internal person to CC.
Would love the help!
Thank you!
Hi Julie,
So the ’email look up list’ is stored in a separate workbook?
This list will contain several email addresses? In the same cell, or in multiple cells?
Regards
Phil
Hi Philip, I hope you can help me with this?
I am trying to automate an excel worksheet (supplier invoice) to save as a PDF. I would like the filename to pick up the supplier name and unique invoice number in the PDF filename but I can’t get this to work for me. It keeps saving the PDF but calling the file as “false”. If you or any of your readers have any ideas, that would be super. I’ve included the VBA code that I used. Regards Pat.
Private Sub cbSaveAsPDF_Click()
Dim sPath As String
Dim sFile As Variant
Dim ws As Worksheet
On Error GoTo Errhandle
sPath = ThisWorkbook.Path & “\” & “Invoice” & Me.Range(“f9″)
sFile = Application.GetSaveAsFilename _
(InitialFileName = sPath, _
filefilter:=”PDF Files (*.pdf), *.pdf”, _
Title:=”Select folder and file name to save “)
If sFile = “false” Then
MsgBox (“Please Choose a File Name”)
Exit Sub
End If
Me.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
Openafterpublish:=True
Exit Sub
Errhandle:
MsgBox (“Document Not Saved”)
End Sub
Hi Pat,
You’re missing a colon when specifying the value for InitialFileName. It should be
Also, when you cancel the GetSaveAsFilename dialog, it returns a Boolean False, which is stored in sFile. The test
is checking if sFile contains the string value “false” because wrapping the word in quotes makes it a string. You just need to test
Cheers
Phil
Hi,
Thank you for this very helpful VBA coding. I’m very new and would like to know how the file can be saved automatically into the temporary folder in the C: drive. If possible, which codes should be deleted?
Hi Michelle,
This file saves the PDF into c:\temp
https://d13ot9o61jdzpp.cloudfront.net/files/save-pdf-to-temp.xlsm
To change this destination edit the code and find the variable DestFolder, and change that value to whatever folder you want.
Regards
Phil
I have been looking EVERYWHERE to find the code to do this! Silly me. I should know by now that this is THE place to find it.
Regards,
Bob Kaplan
Mynda and Catalin’s #1 fan
🙂 thanks Bob. Glad you found this useful.
Regards
Phil
Hello Phil,
I will need to use this macro for at least 14 sheets at a time. I think I am reading that I can get this macro to work like this:
1. Create PDF for each sheet at the same time.
2. Create an individual email for EACH PDF which is an person getting their payroll explanation.
3. Address and send the email to 14 different (in this example) people all at the same time so I don’t have to view and manually send each email.
Is this correct. And if so, how might I accomplish this? Every time I’ve run tests it stops after each person, allows me to add text to the email etc. Nice, but I don’t want to have to do that for this many people every time we do payroll.
I’ve tried to figure this out on my own as I love learning new VBA code.
Thanks,
Bob
Hi Bob,
Please take a look a this topic, there is a SendAllSheets code to loop through all sheets.
You can also set an exclude list:
You can set a list to exclude:
Dim ExcludeList as String
ExcludeList=”Sheet1, Sheet2, Sheet3″
If Instr(ExcludeList, Sheet.Name)>0 then
msgbox “This sheet will not be printed”
End If
Cheers
Catalin
MEGA thanks! I will check it out now.
Bob
Me again. Do I use this new code along with the code already there but basically create a loop so it goes through the main code for each worksheet except the ones I want to exclude?
UPDATE – OK. I think I get it now. I guess this “SendAllSheets” macro causes the initial macro to run too. I am puzzled as to how you make that happen without a “call” statement.
ALSO, I’m guessing that there must be a way to also have the macro populate the “To” field with the email address of the person I’m sending the PDF to? Can you please give me some help there?
THANKS!
Hi Bob,
SendAllSheets just starts a loop that activates one sheet at a time and calls the original code for emails.
There is an instruction in the original code, you just have to locate it and read it:
Email_To = “” ‘Change this if you want to specify To email e.g. ActiveSheet.Range(“H1”) to get email from cell H1
The code will always take the To email from current active sheet, the SendAllSheets procedure just activates each sheet, this way, the new sheet will have the To email from that sheet cell H1 for example.
Look forward to seeing code
Hi David,
You can download the code from the bottom of the blog post.
Phil
GOOD
This is AWESOME. Can you please direct me to where I can loop through all sheets in the workbook and send to separate recipients noted in cell H1 of each respective sheet?
Hi Ashley,
Please take a look at this topic, last message has a code that can loop through all sheets to send that sheet by mail.
The code is using also the procedure developed by Phil – create_and_email_pdf
You can open a new topic on our forum if you need specific help on your situation.
Catalin
This is great! Thank you! One question regarding the month file name. I am using this (as a novice) to send a PDF Invoice with the name of the company in a merged cell C9; however, the code always skips the first word in the name (e.g. “Customer Invoice_County”, leaving out “Jefferson”. Also, I want to include the month (or full date) as well; however, I get a run error when referencing my invoice date in the MM/DD/YYYY format, located in merged E3 cell. Any help would be greatly appreciated. Thank you!
Hi Lance,
Make sure the date is not formatted as xx/xx/xxxx in your file name text, because / is a folder separator, the path will be wrong in this case. Format date as xx-xx-xxxx instead.
Format(Cells(3,1),”mm-dd-yyyy”)
Hi, thank you very much for the code. I was wondering if there is any way that when i save the PDF some parts from the excel will not be saved to it and not seen
thanks
Hi,
You can simply hide rows/columns you don’t want to see in PDF, will work.
Catalin
Hello
Thanks for the VBA
When I execute, I get a runtime error ‘1004’:
Document not saved etc
debug this line
‘Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
Why is this”
Regards
Geoff
Hi Geoff,
It might be a wrong file name, or you are using excel 2007 without the add-in “Save as PDF or XPS” installed.
Cheers,
Catalin
Hi Geoff,
You’ll get this error for a number of reasons.
1. What is the PDF file name? Just before the line
add this
and you’ll see the full path and name of the PDF file printed in the Immediate window in the VBA editor. If your Immediate window isn’t visible press CTRL+G to open it. Perhaps the path or file name are invalid?
2. Is the folder where you are trying to save the PDF file write protected?
You could get this error if the PDF you are trying to overwrite is open in another program, but I’ve coded to allow for that possibility so you’d get a different message if this was the case.
An alternative to adding the degug.print statement above is to step through the code using F8 until you get to the point where the PDFFile value is created. You can then hover our muose over the PDFFile and it’ll tell you what it is. You can read more about Debugging VBA
Regards
Phil
Hi there,
The code is great however i would like to save the pdf in the active workbook’s current directory, i currently get forwarded to the ‘save to folder’ prompt, i would appreciate your advice.
Regards
Faith
Hi Faith,
This code does what you want.
Regards
Phil
Hi There. This code is amazing and exactly what I needed, thank you. Please can you help me with a problem that I am having with the sending. When I enter and email address to send the PDF to, the email gets sent back to me and not the email address that I typed in. I have no idea what I am doing wrong?
Hi Kerry,
Not sure where you type the destination email, it should be into the Email_To parameter, please read again the section Email_To, Email_CC, Email_BCC, where there is a detailed description of how you can modify these fields.
Let us know if you managed to make it work
Catalin
Thank you for the above, however, when I try to incorporate it I get an error. What I am trying to do is save certain sheets as separate PDFs and then email out those PDFs in separate emails.
So far for the code below, it creates the designated spreadsheets as separate PDFs. It then creates the email, but I get an error when trying to attached the PDF to the email under the “.Attachments.Add PdfFile” line at the bottom of the code.
Any help would be grateful!
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim thisWb As Workbook
‘ Not sure for what the Title is
Title = Range(“B1”)
‘ Define PDF filename
PdfFile = Range(“D2”).Value & “_Commission Statement_” & ActiveSheet.Name & “.pdf”
‘Check file location
Set thisWb = ActiveWorkbook
‘ Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=thisWb.Path & “\SYD Statements\” & PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
‘ Prepare e-mail with PDF attachment
Set OutlookApp = CreateObject(“Outlook.Application”)
Set OutlookMail = OutlookApp.CreateItem(0)
‘ Prepare e-mail
With OutlookMail
.Display
.To = “”
.CC = “”
.BCC = “”
.Subject = “Commission statement”
.Body = “”
.Attachments.Add PdfFile
End With
End Sub
Hi Peter,
In your code, you are using thisWb.Path & “\SYD Statements\” & PdfFile to save the file.
Same full path should be provided for attachments, not just PdfFile:
.Attachments.Add PdfFile
Should be:
.Attachments.Add thisWb.Path & “\SYD Statements\” & PdfFile
Cheers,
Catalin
Wonderful post. I’m also a beginner user of Excel VBA macros. This was very helpful. However, I’m trying to figure out how to email the Sheet as .xlsx instead of .pdf so my recipients can edit it. I also want the macro to loop through all Sheets in the workbook to email it to the email on each sheet. Please help. Thank you!
Hi Cynthia,
You have to replace the Export to pdf section with this code:
Replace this:
‘Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
With this code:
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Filename:=PDFFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close True
End With
Make sure you change the extension from .pdf to .xlsx:
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & CurrentMonth & “.xlsx”
And of course, declare the wb variable at the beginning of the code:
Dim wb As Workbook
See this topic for a code that will send all sheets, look for SendAllSheets procedure.
If you need more help, let us know.
Catalin
im getting an error saying not defined
Set OutlookApp = CreateObject(“Outlook.Application”)
Set OutlookMail = CreateItemFromTemplate(“C:/Users/g4def/Downloads/test.oft”)
Hi Matthew,
The second line does not look as I suggested:
It should be:
Set OutlookMail = OutlookApp.CreateItemFromTemplate(“C:/Users/g4def/Downloads/test.oft”)
Like all of us, we love this code so thank you for your skill.
I have a template in outlook that contains the body of the text my signature and details of what i am sending. Is there away in the code to open up this template and not the standard new email template?
Thank you for your time:-)
Hi Matthew,
Use this:
.HtmlBody=YourTextHere & .HtmlBody
This will append the existing signature to the text you want to write in the body section. Make sure you display the message before sending, to allow signature loading.
Catalin
If you want to use a template instead, this lines should replace the existing version:
Set OutlookApp = CreateObject(“Outlook.Application”)
Set OutlookMail = OutlookApp.CreateItemFromTemplate(“C:/TemplatesFolder/mytemplate.oft”)
wow, that is so amazing.
i am saving very hard now to buy a course so i can learn all this stuff.
thank you
Hello,
I am using the code below which I modified and it works very well. While it is working I need it to work better. I can’t seem to make work adding the month to the subject line as in the line with cell reference H6. I also would like to add a line to populate the body of the email with a greeting, a message and a thank you. Any help is appreciated.
Tim
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 = “Executive Motorcoach Storage Invoice” ‘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 = True ‘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(“B15”) ‘Change this if you want to specify To email e.g. ActiveSheet.Range(“H1”) to get email from cell H1
Email_CC = “[email protected]”
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
DestFolder = ThisWorkbook.Path & Application.PathSeparator & “PDF Folder”
If Len(Dir$(DestFolder, vbDirectory)) = 0 Then MkDir DestFolder
‘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 _
& “.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
Hi,
On your last lines of code, siply add the body:
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = EmailSubject & CurrentMonth
.HtmlBody=ActiveSheet.Range(“H6”) & “
” & _
“Other Text here”
To write multiple lines, use a html line break: break lines in text
You can use any html formats, to set the font size, bold or any other formats needed.
Hi,
Can the code send say, 20 sheet to 20 different people by executing the code once.
We can have the email address in sepcific row/colums for the code to pick the TO Address from each sheet. If you could share this code i would be hugely beneficial with this code.
Many thanks in advance.
Subhasis
Hi Subhasis,
When sending one sheet, you want to send the email to all emails from all those 20 sheets?
In this case, you don’t need a code for this, just type all those 20 addresses in each sheet, separated by semicolon.
Catalin
Hi Thanks for the reponse. My requiremet is below:
Each sheet will have seperate email address
.
There should be a loop to Create PDF for each sheet and create email with this attachment and pick the email address from the cell. The it loops back to second sheet and does the same as above. This goes on till all the sheet is completed.
Hope I am able to narrate my requiremet.
Hi Subhasis,
Try this code:
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
create_and_email_pdf
Next
End Sub
There are 2 forum topics you can read, for the same code: email pdf from each sheet
And this one: exporting-pdf-to-outlook
Catalin
is it possible to change from pdf file to word doc?
Hi,
Yes, you can add any valid file instead of that pdf (some files are not accepted by outlook: file type is not accepted, or file size is too big), simply change the attachment link to your file.
Hey, what part of the code will need to be changed to save it as a new excel sheet?
Hi Bob,
This is the line that does the conversion to PDF:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
If you need to save the sheet as a new workbook, you need a different code:
Sheets(Array(“Sheet1”, “Sheet2”)).Copy ‘multiple sheets can be copied in the same time in a new sheet
With ActiveWorkbook
.SaveAs Filename:=Filename
.Close
End With
Can you explain how to change the code from creating a PDF to creating a Word DOC?
Hi Patrick,
You should open a new topic on our forum, it’s not the same thing to print to PDF or create a word document.
It needs a specific structure designed, please upload to forum sample files so we can help you.
Cheers,
Catalin
Hi,
Thanks for sharing the code.
Please suggest me if there is any possibility to protect the password referring to cell??
Thanks in advance.
If the password is in a cell, there is no real place to hide, even if you set the sheet to very hidden with vba. If someone knows the location of the cell, it can be obtained from any open workbook, even with a simple formula referencing the cell.
To make things harder for those interested in the password, you can try altering the original password from cell with vba before using it, replace one of the chars for example:
Pass=Replace(Pass,”t”,”z”)
Only people that knows this operation will be able to use the original password.
Want to start by saying that I absolutely love this code. Thank you so much for Posting.
I am relatively new to VBA so if you are able to help I would greatly appreciate it.
I have gotten every thing to work for my application except for some line spacing in my body. I have used the & vbCrLf to separate the three cells am joining how ever when the email is produced the body is all on one line. Please see my code below. thank you in advanced for the help.
Email_Body = ActiveSheet.Range(“F70”) & vbCrLf & ActiveSheet.Range(“F71”) & vbCrLf & vbCrLf & ActiveSheet.Range(“F72”)
Hi Aaron,
Try using html tags instead of crlf:
Email_Body = ActiveSheet.Range("F70") & "
" & ActiveSheet.Range("F71") & "
" & "
" & ActiveSheet.Range("F72")
This is really helpful! How can I create one pdf from 2 separate worksheets?
Hi,
The code by default will print the active sheet. If you select more than one sheet, all selected sheets will be printed into a single PDF file.
To select more than 1 sheet use:
ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")).Select
No other change is needed, the existing code for publishing to PDF will also work for this scenario.
I’ve used the code above and I am getting the following error:
Run-time error ‘1004’:
Document not saved. The document may be open, or an error may have been encountered when saving.
Debug brings me here:
[code]
‘Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
[/code]
Hi Stephanie,
Can you upload a sample file with your code so we can test it?
Looks like the file name is wrong, but I will know for sure only after seeing the code in action.
You can sign-up to our forum, create a new topic and upload your file.
Catalin
I just uploaded it – thank you!
https://www.myonlinetraininghub.com/excel-forum/vba-macros/exporting-pdf-to-outlook#p3489
Hi All,
I love this VBA! only i want to save the pdf to a fixed directory without the user knowing it. Only when the fil already exist the user needs to have a message. Do you know how?
Thank you so much in advance!!
Hi Pier,
instead of this part of the code:
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
Simply use:
DestFolder=”C:\My Files” (change this to the path you want)
If the file already exists, there is code that will ask users if they want to overwrite it, look for this in the code:
‘If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
You can edit as you like the messages displayed to user in this part of the code.
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.
Hi Sam,
You can use special folders:
Dim WShell As Object
Dim DesktopPath As String
Set WShell = CreateObject(“WScript.Shell”)
DesktopPath = WShell.SpecialFolders(“Desktop”)
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
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.
Is there a way to create the PDF in as a protected PDF (w/password) using the code you mentioned?
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
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
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
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?
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
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”
Hi Ciara,
Try this:
PDFFile = DestFolder & Application.PathSeparator & Range("F7") & "_" & Range("F6") & "_" & Range("A11") & ".pdf"
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!
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.
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
“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””
I was unsuccessful in getting this to work even with these changes. I was getting the same error as you above, so then I added your fixes and now I get the error:
Run-time error ‘424’:
Object required
I wonder if I added one of those commands in the wrong place? Can you elaborate for me? I added Dim Filename as String to the beginning of the macro with the rest of the “Dims” and then tried putting Filename = PDFFile & “.pdf” in like 10 different places trying to get it to work, but kept getting that error I mentioned…help would be appreciated! Thank you!!
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?
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
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
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)
Hi there,
All works awesome thanks. How do I change DestFolder from H Drive to the current folder the workbook is in?
Many thanks
You can simply use:
DestFolder = ThisWorkbook.Path & “\”
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
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
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
Hi Wills,
You have a reply in the forum, if you need more help, we can continue the conversation there.
Cheers,
Catalin
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
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
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!
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
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
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
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.
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
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
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
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
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 Functionsorted
thanks a lot.
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!
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!
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.
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
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
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”
You are amazing. This is exactly what I needed. Thank you so much!
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
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.
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!
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
Hi, I am very new at this and need help. I keep getting an error message that “Sub or Function not defined”.
Thank you!
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
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,
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
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
never mind i figure it out me self, just needed to open my eyes 🙂
🙂 Glad you figured it out Dennis.
Regards
Phil
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
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
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
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
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
Hi Matt,
Use this:
.HtmlBody=ActiveCell.Text & .HtmlBody
This will append the existing signature to active cell text.
Catalin
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,
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
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?
Hi Barry,
Can you upload a sample file with your code to our forum? It will be easier to help you.
Catalin
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
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
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
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
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
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
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”
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.
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 ' 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 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 SubHi Joe,
Instead of ActiveSheet.ExportAsFixedFormat…
use:
Sheets(“Sheet1”).Range(“A1:J30”).ExportAsFixedFormat…
This will print only the indicated range, not the entire sheet.
Thanks Philip – Useful and easy to implement 🙂
You’re welcome.
Phil
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
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
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.
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
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.
No worries Martin, glad you got it resolved.
Phil
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?
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
Regards
Phil
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?
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
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
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
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
Hi Chase,
This version seems to be close to what you need:
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
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
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.
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
Thanks for feedback Catalin
I will do
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.
Hi Steven,
This version may work for you:
Option ExplicitSub 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
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
Hi Catalin
You are a star as always. Thanks so much. I aspire to have your knowledge.
You’re welcome Steven
As you already know, you’re in the right place to gain knowledge 🙂
Catalin
I am struggling to follow this example to automatically email each worksheet with an email address listed in a certain cell (E1) and ignore those that don’t. Here is my attempt so far. Your help is greatly appreciated.
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, EmailBody As String, EmailSignature As String
Dim CurrentMonth As String, CurrentYear 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
Dim Wks As Worksheet
CurrentYear = “”
‘ *****************************************************
‘ ***** You Can Change These Variables *********
EmailSubject = “Performance Improvement Bonus Calculation ” ‘Change this to change the subject of the email. The current month is added to end of subj line
EmailBody = “Attached is your bonus explanation for the current current bonus distribution. Please contact Dr. Kelly for any questions or concerns.”
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 = ActiveSheet.Range(“E1”) ‘Change this if you want to specify To email e.g. ActiveSheet.Range(“H1”) to get email from cell H1
Email_CC = “”
Email_BCC = “”
DestFolder = “C:\Users\tkell\OneDrive\USAP Critical Care\Administrative\Human Resources\Bonuses\Bonus Calculations”
‘ ******************************************************
For Each Wks In ThisWorkbook.Worksheets
Application.Goto Wks.Cells(1 / 1)
‘Current year stored in M1 (this is a merged cell)
CurrentYear = Mid(ActiveSheet.Range(“M1”).Value, InStr(1, ActiveSheet.Range(“M1″).Value, ” “) + 1)
‘Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& “_” & CurrentYear & “.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 & CurrentYear
.Attachments.Add PDFFile
.Body = EmailBody
If DisplayEmail = False Then
.Send
End If
End With
Next Wks
End Sub
Hi Todd,
You should call the procedure from another procedure, because the email address is read outside your loop. You can start the loop before the variables (include the variables inside the loop), or use this code to loop through sheets and check if it needs to be sent (remove the For Next loop from your code):
Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
if Len(ActiveSheet.Cells(1,"E")) > 0 Then create_and_email_pdf
Next
End Sub
Cheers,
Catalin
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?
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
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 :: 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
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
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
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.
Great then, you already have a reply on Help Desk 🙂
Catalin
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!
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
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?
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
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
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
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
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
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?
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
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
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
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
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
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 ' 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, 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 SubHi,
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
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!
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
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!
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
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
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
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
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
Thanks! You are awesome by helping beginers like me with such graphical explanations.
No worries Christian, glad we can help.
Regards
Phil
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 = “[email protected]”
.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 = “[email protected]”
.CC = “”
.BCC = “”
.Subject = “kte features”
.Body = “Please check and read this document.”
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
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
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
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
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
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?
Hi Birinder,
Change this code from line 24:
Email_To = "" change to: Email_To = ActiveSheet.Cells(1,"A").TextCatalin
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—-
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 = "[email protected]"
.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
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 = “[email protected]”
.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
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
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.
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
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
Hi Sharon,
Do you want to specify a different filename each time, or use the same filename?
Phil
Phil
Same folder but differing file names dependant on worksheet name eg:
“G:\Sharon\Develop\Marketing”
“G:\Sharon\Develop\Operations”
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
Thanks
Got it working fine
You’re wellcome Sharon 🙂
Catalin
I can’t get this to work, I’ve pasted as suggested my exact destination folder, but getting a Run-time error ‘1004’?
Hi Daisy,
Can you upload a sample file with your code so we can see it? Sign-up to our forum and create a new topic, to upload your sample file, we will gladly help you.
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.
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
I’m getting a Run-Time error ’52’ Bad file name or number on
If Len(Dir(PDFFile)) > 0 Then
Thanks,
Rachael
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
Hi Phil,
Fantastic blog and very helpful – thank you so much.
Very clear to understand and it has saved me hours
You’re most welcome Tony. Thanks for the question which lead to this post.
Regards
Phil
Can I use the VBA for Lotus Note and not Outlook? thank you
Hi Hope,
The code refers to specific Outlook objects and methods, each application has its own library of objects, methods and properties, therefore there is no way to use code written for outlook in another application/email client.
Catalin
Hello Everyone,
Can anyone help me out to crate VBA code if below details, I want to crate single PDF for upper 3 Brance and then it merged with another PDF that is 4 Branch, I hope you all understand my
query.
Hi Deepak,
Sorry I don’t understand what you want to do. Please start a topic on our forum and attach your file(s) there.
Regards
Phil