Forum Discussion
Solved
Re: Macro to save as PDF with auto filename as cell value
Hi I recently used the following Macro, provided by Gary's Student, to create a PDF from an active sheet, generate a unique Filename based on a cell ref and save it to a specific location. This m...
This is code I use.
End SubPrivate Sub Email() Dim objOutlook As Object Dim objMail As Object Dim signature As String Dim oWB As Workbook Set oWB = ActiveWorkbook Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .Display End With signature = objMail.HTMLbody With objMail .To = oWB.Sheets("Sheet1").Range("A1").Value ''.SentOnBehalfOfName = "" .Subject = strMySubject ''.body = "Dear Sir," & vbNewLine & vbNewLine & "Add stuff here" & vbNewLine & vbNewLine & signature .HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Dear Sir," & "<br> <br>" & "Add stuff here" & "<br> <br>" & signature & "</font>" .Attachments.Add (strSaveFileName + ".pdf") .Display End With Set objOutlook = Nothing Set objMail = Nothing End Sub
This is code I use.
End Sub
Private Sub Email()
Dim objOutlook As Object
Dim objMail As Object
Dim signature As String
Dim oWB As Workbook
Set oWB = ActiveWorkbook
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.Display
End With
signature = objMail.HTMLbody
With objMail
.To = oWB.Sheets("Sheet1").Range("A1").Value
''.SentOnBehalfOfName = ""
.Subject = strMySubject
''.body = "Dear Sir," & vbNewLine & vbNewLine & "Add stuff here" & vbNewLine & vbNewLine & signature
.HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Dear Sir," & "<br> <br>" & "Add stuff here" & "<br> <br>" & signature & "</font>"
.Attachments.Add (strSaveFileName + ".pdf")
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
Thank you Andrew
You‘re no doubt aware that I am new to Coding and very much appreciate your response. I will hopefully be able to pass on assistance to others in the very near future.
Andrew
Just to let you know that the code below works well for me, and thank you again.
Command Button: -
- Generates a pdf of the ActiveSheet
- Saves pdf to a specific location, indicated in Cell H1, with an auto Filename based on the Sheet Date within Cell I3, formatted as YYMMDD
- Opens Outlook and displays email with pdf attached (file with date "Now")
- Auto fills Recipients, reading from Cell C50
- Email Body as required
When i'm happy i will change code to automatically send email not display.
for reference:-
Cell H1: ="I:\2017 - 2018\Operations Unit\Day Sheets\"&"DS_"&TEXT(I3,"yymmdd")&".PDF"
Private Sub Email_Sheet_Click() Dim objOutlook As Object Dim objMail As Object Dim signature As String Dim oWB As Workbook Set oWB = ActiveWorkbook s = Range("h1").Value ' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ s, Quality:=xlQualityStandard, IncludeDocProperties _ :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False PDF_File = "Insert Path here\DS_" & Format(Now, "YYMMDD") & ".pdf" Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .Display End With signature = objMail.HTMLbody With objMail .To = ActiveSheet.Range("C50") .Cc = ActiveSheet.Range("C55") .Subject = "Insert Subject Here" .HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Hi," & "<br> <br>" & "Insert email body here" & "<br> <br>" & signature & "</font>" .Attachments.Add PDF_File .Save .Display End With Set objOutlook = Nothing Set objMail = Nothing End Sub- Worked great..saves me at least 2hrs a week!
Please help...
This code is perfect for what I want to do in order to simplify a procees repeated at work but am a little stuck. I have it working to a point..
PDF Is saving in the directory pre set in Cell A1 all ok.
Outlook then opens (no attachment and no email addresses inserted) and I then get the following error (See attached)
I do not need to save the doc with date. Happy to Modify Cell A1 (C:\Users\mark\Desktop\quotes\12345.pdf each time its used with the prefered directory/filename. Clearly there is some of the code and how it works am not understanding.
I dont understand why the email addresses dont pull through from cells A2 and A3 and not sure what I need to do in order to have the file which has saved ok in the required directy attach to the email.
If anyone can help me get this working would be much appreciated also if any additional information is required just ask. Full VBA below....
Sub Email_Sheet_Click()
Dim objOutlook As Object
Dim objMail As Object
Dim signature As String
Dim oWB As Workbook
Set oWB = ActiveWorkbook
s = Range("A1").Value
'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
s, Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
PDF_File = "Insert Path here\DS_" & Format(Now, "YYMMDD") & ".pdf"
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.Display
End With
signature = objMail.HTMLbody
With objMail
.To = ActiveSheet.Range("A2")
.Cc = ActiveSheet.Range("A3")
.Subject = "Insert Subject Here"
.HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Hi," & "<br> <br>" & "Insert email body here" & "<br> <br>" & signature & "</font>"
.Attachments.Add PDF_File
.Save
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
End SubAny help will be much appreciated!
These small edits should make the code work (Please see changes in bold):
Sub Email_Sheet_Click() Dim objOutlook As Object Dim objMail As Object Dim signature As String Dim PDF_FileName As String Dim oWB As Workbook Set oWB = ActiveWorkbook 'Change your string to this.... PDF_FileName 'or change your cell value in A1 'This is the name of your PDF... 'Change accordingly.... PDF_FileName = "C:\Users\mmickle1\Desktop\DS_" & Format(Now, "YYMMDD") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ PDF_FileName, Quality:=xlQualityStandard, IncludeDocProperties _ :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .Display End With signature = objMail.HTMLbody With objMail .To = ActiveSheet.Range("A2") .Cc = ActiveSheet.Range("A3") .Subject = "Insert Subject Here" .HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Hi," & "<br> <br>" & "Insert email body here" & "<br> <br>" & signature & "</font>" .Attachments.Add PDF_FileName 'Now that the name is correct it will work. .Save .Display End With Set objOutlook = Nothing Set objMail = Nothing End SubIf you have additional questions it may be beneficial to attach a sample file for testing.
I'm very new to coding, so I wanted to add a little twist to this thread. Is it possible to have a code to convert the current spreadsheet to PDF, create an email through Outlook, but not save the document?
Thanks!
From what I remember it's necessary to save the document to attach the file. However, you can save the PDF to a temporary directory and then once done using it you can just delete it:
It would look something like this:
TempFilePath = Environ$("temp") & "\" 'This defines the filepath ---> C:\Users\username\AppData\Local\Temp TempFileName = "Your File Name Goes Here" 'Name File
ActiveWorkbook.SaveAs TempFilePath & TempFileName 'Save file in Temporary Directory 'Email Workbook to people With OutMail .To = "YourName@Email.Com" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "This is the email body" 'Use "Blah Blah Blah" & Chr(13) & "This is another line" .Attachments.Add TempFilePath & TempFileName .Send End With 'Delete the Temporary File Kill TempFilePath & TempFileName
