Forum Discussion
Re: Macro to save as PDF with auto filename as cell value
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
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
Hi Mark,
I'm glad to see this code has been helpful and is still being developed.
1. you are not using the error function correctly.
2. your PDF_FILE variable does not reference a sheet
3. your s variable does not reference a sheet and is a duplicate of PDF_FILE
Example
Public wb As Workbook
Public sh As Worksheet
Private Sub Test()
On Error GoTo errormessage
Set wb = ActiveWorkbook
Set sh = ActiveSheet
With sh
If .Range("C4") = Empty Then
MsgBox ("please enter values in C4")
End
ElseIf .Range("C5") = Empty Then
MsgBox ("please enter values in C5")
End
ElseIf .Range("C9") = Empty Then
MsgBox ("please enter values in C9")
End
End If
End With
Dim Filename As String
Filename = "C:\Users\Public\Documents\" & sh.Range("O5").Value & ".xlsm"
wb.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
errormessage:
With Err
Select Case .Number
Case 1004 'add code for 1004 error
MsgBox "Error: " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly + vbExclamation, "Error"
Case Else
MsgBox "Error: " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly + vbExclamation, "Error"
End Select
Resume Next
End With
EndOfSub:
End Sub