Forum Discussion

Copper Contributor

May 30, 2017

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...

Macros & VBA

Need Help

Andrew Jones

Jun 01, 2017

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

mark ainscough

Brass Contributor

May 23, 2018

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 = "" & "Hi," & " " & "Insert email body here" & " " & signature & ""
 .Attachments.Add PDF_File
 .Save
 .Display
 End With

 Set objOutlook = Nothing
 Set objMail = Nothing
End Sub

Any help will be much appreciated!

Matt Mickle

Bronze Contributor

May 23, 2018

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 Sub

If you have additional questions it may be beneficial to attach a sample file for testing.

JDrake06
Copper Contributor
Dec 15, 2021
Matt Mickle

Hi Matt, found this code and it is very close to what I am after, however I am a complete VBA novice and the small changes I need to make I can't seem to make work. Are you able to advise? Would be really appreciated.

So I need to do the following if possible:

> Save the active worksheet as a PDF, using Cell "M7" for the name and saved in to a specific file path (which I will put in to the code), however with the final folder name to save in to being specific to Cell "W3" which will change via a drop down option

> Open Outlook new email and attached the PDF
> In "to" use email addresses from Cell "X3, Y3 and Z3" (sometimes 1 or 2 of these may be blank, will this cause an error?)
> In subject add "PO & Cell M7 (or PDF File name)
> In body add "Text" (line break x2) "text" (line break x2) "text & Cell M10" (line break x1) "text & Cell W6" (line break x2) "text" (line break x2) "text" end

Thanks

James
JDrake06
Copper Contributor
Dec 15, 2021
Matt Mickle

old post but wondering if you could help as this is very close to what I need, however I am a VBA novice and I can't make the small changes work in my favour!!

I need a code to do the following:

> Save active worksheet only as a PDF, as the name from cell "M7"
> Save in to specific file path however with a variable final location based on specific name, taken from cell "W3"
> Open Outlook and attached this PDF file in a new email
> Add Subject of "PO & PDF File Name (or cell "M7")
> Add body of "Hi (line break x2) *insert text* (line break x2) *Date & cell "M10"* (line break x1) *Booking Slot & Cell "W6"* (line break x2) *insert text* (line break x2) *Regards*

Would be really grateful if you are able to help.

Thanks

James

mark ainscough

Brass Contributor

Jun 07, 2018

Thanks Matt sorted now appreciate the quick response. For anyone attempting a similar code I have also added a few things as wanted email subjectfield to display a variable cell value from an INDEX/lookup and also wanted the body of the email to include a variable cell value (I am too lazy to actually type the information in when the email opens!)

Sub emailsavePDF()

Dim objOutlook As Object
    Dim objMail As Object
    Dim signature As String
    Dim oWB As Workbook
    Set oWB = ActiveWorkbook
    
    
    
     s = Range("O7").Value
  
 '
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         s, Quality:=xlQualityStandard, IncludeDocProperties _
         :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         
         
    PDF_File = Range("O7").Value & ".pdf"
 
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
        
    With objMail
        .display
    End With
        signature = objMail.HTMLbody
    With objMail
        .To = Sheets("Estimate").Range("O9")
        .Cc = Sheets("Estimate").Range("O10")
        .Subject = Range("N23").Value
        .HTMLbody = "<BODY style=font-size:11pt;font-family:Calibri>Hi;<p>Please find attached estimate for trailer " & Range("N24") & "<p> Any questions please don't hesitate to ask." & "<br> <br>" & signature & "</font>"
        .Attachments.Add PDF_File
        .Save
        .display
    End With


    Set objOutlook = Nothing
    Set objMail = Nothing
End Sub

Matt Mickle

Bronze Contributor

Jun 08, 2018

Hey Mark-

Glad you were able to get it working! Please feel free to post back to the community if you have additional Excel questions.

mark ainscough

Brass Contributor

Jun 27, 2018

Formula works great but I need to make an amendment and struggling to get it working correctly.
I want a error message to appear telling the user to check they have met certain conditions should they forget to complete certain cells which constitute the file name the doc is to be saved as.
There are x2 Macros that run together email and save PDF and save Excel doc both below.

I have inserted a goto On Error command but struggling getting it right. It either displays as soon as the Macros are run regardless of error existing or it displays x2 times for each macro and then (even if the cells are left blank) continues to save the excel doc with no file name which I did not think was possible.

I need the message to box to simply appear once and then end/do nothing after the user sees the message rather than save the excel doc with no filename.

Sub emailsavePDF()

Dim objOutlook As Object

    Dim objMail As Object

    Dim signature As String

    Dim oWB As Workbook

    Set oWB = ActiveWorkbook

   

        On Error GoTo ErrMsg


     s = Range("O7").Value

 '

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

         s, Quality:=xlQualityStandard, IncludeDocProperties _

         :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

 PDF_File = Range("O7").Value & ".pdf"

 Set objOutlook = CreateObject("Outlook.Application")

    Set objMail = objOutlook.CreateItem(0)

       

    With objMail

        .display

    End With

        signature = objMail.HTMLbody

    With objMail

        .To = Sheets("Estimate").Range("O9")

        .Cc = Sheets("Estimate").Range("O10")

        .Subject = Range("O12").Value

        .HTMLbody = "<BODY style=font-size:11pt;font-family:Calibri>Hi;<p>Please find attached estimate for trailer " & Range("O13") & "<p> Any questions please don't hesitate to ask." & "<br> <br>" & signature & "</font>"

        .Attachments.Add PDF_File

        .Save

        .display

      
        Exit Sub

      ErrMsg:

 MsgBox "1: A customer must been selected in cell C4" & vbNewLine & "" & vbNewLine & "2: A trailer number must be entered in cell C5 and must not contain any symbols" & vbNewLine & "" & vbNewLine & "3: A breif repair description  must be entered in Cell C9 and must not contain any symbols" & vbNewLine & "" & vbNewLine & "4: You are connected to the network", , "THE FOLLOWING STEPS MUST BE COMPLETED"

 
        Exit Sub

    End With

    Set objOutlook = Nothing

    Set objMail = Nothing

End Sub



Sub emailsaveexcel()

    Dim newWB As Variant

    Dim wb1 As Workbook

    Set wb1 = ActiveWorkbook

   

          

   

    With wb1

        .SaveCopyAs Sheets("Estimate").Range("O5").Text & ".xlsm"

       

 

 

 

Exit Sub

    End With

 

    End Sub