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

Joe Gray

Copper Contributor

Jun 02, 2017

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.

Joe Gray

Copper Contributor

Jun 02, 2017

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

Forum Discussion

Re: Macro to save as PDF with auto filename as cell value