Forum Discussion

Joe Gray's avatar
Joe Gray
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's avatar
    Andrew Jones
    Jun 02, 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's avatar
Joe Gray
Copper Contributor
Jun 01, 2017
Further to my previous post I have managed to adapt the code to do what I required: 1. Create a pdf of ActiveSheet 2. Save pdf into a specific location 3. Name the pdf with a file name based on the sheet date 4. Open an email, with selected recipients, and attach the current pdf to and email If you have any suggestions to develop the code or see any possible errors please let me know. Sub Sent_Email() Dim olApp As Object s = Range("h1").Value ' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ s, Quality:=xlQualityStandard, IncludeDocProperties _ :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False PDF_File = "I:\2017 - 2018\Operations Unit\Day Sheets\DS_" & Format(Now, "YYMMDD") & ".pdf" Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) .Subject = "Daily Resource Sheet" .To = ActiveSheet.Range("C50") .Cc = ActiveSheet.Range("C55") .Body = "Hi," & vbLf & vbLf _ & "Please find attached the Daily Resource Sheet." & vbLf & vbLf _ & "Regards," & vbLf & vbLf _ & "Roads Operations Unit" .Attachments.Add PDF_File .Save .Display End With End Sub

Resources