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
mark ainscough's avatar
mark ainscough
Brass Contributor
Jun 28, 2018

Hi Matt/Andrew

O7 Contains a formula something like =O6&C5&" "&C9 so the filename/directory is the combined contents of cells c5 (Unit number) and c9 (repair description) the directory the file is being saved in (Which varies on a drop down placed in cell C4) must also be selected or the formula will not know where to save it. The directory varies depending on customer the spreadsheet is being used for.

 

Just the elaborate the Macro works perfectly for me I just need a pop up message if cells 06 C6 and C9 are left blank as this will cause an error as the Macro will not know where to save if C4 is blank (Technically the user only needs to put text in one box for the file name O6 or C5) an error will only occur if both are blank. The only other time an error would occur is if the user is not connected to our network as all of the directory’s are on our network drive. The user does not see or edit Cell O7

I need an error handling code reminding the user to fill in these cells if they forget rather than the standard Excel message which doesn't really help the user. It may be possible to have a Macro telling the user to fill in these cells but an error will still occur if they are not connected to our network/VPN so error message will still occur.

 

Code without my attempt at error goto below:

 

 

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("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

    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"

    End With

 

    End Sub

 

Matt Mickle's avatar
Matt Mickle
Bronze Contributor
Jun 28, 2018

Mark-

 

Try something like this:

Sub WhateverSub()

On Error GoTo ErrHandler

'Your Code Here....

Exit Sub

ErrHandler:


    'If one of these cells is blank....
    If Range("C4") = vbNullString Or Range("C6") = vbNullString Or Range("C9") = vbNullString Then
        MsgBox "Please fill in cells O7, C6 and C9 they are mandatory fields that " _
            & "have been left blank!!", vbCritical, "Error Message"
        Exit Sub
    Else
    'Some other error like a VPN error
        MsgBox "Please make sure you have a network connection!", vbCritical, "Error Message"
        Exit Sub
    
    End If

End Sub

You can check to see if a directory exists like this....

If Dir("C:\Users\mmickle1\Documents\", vbDirectory) = "" Then
    MsgBox "Directory does not exist..."
End If

 

You may consider having some data validation to light up a cell red if the mandatory fields are not filled in as an extra safe guard...

 

Here's the original article I learned about error handling with... it's pretty thorough.  In fact I still reference it occasionally :

 

http://www.cpearson.com/excel/errorhandling.htm

 

 

Resources