SOLVED

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

Copper Contributor

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 macro works well for me, however, I would like to add to it so that I can also attach it too and email and send to a specific email group (using Outlook). Maybe have it allow you to View so it can be sent manually, or the option to automatically send.

 

Below is the value I used to create the filename based on the date entry within I3 and I formatted it as shown.

 

Cell H1 "=I:\2017 - 2018\Operations Unit\Day Sheets\"&"DS_"&TEXT(I3,"yymmdd")&".PDF"

 

Sub Macro1()

 

s = Range("H1").Value

'

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

            s,  Quality:=xlQualityStandard, IncludeDocProperties _

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

 

End Sub

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 

End Sub

 

 

 

26 Replies
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
best response confirmed by Joe Gray (Copper Contributor)
Solution

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

And this is code to export to PDF

 

You obviously need a full path as a string to save the file to

 

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strSaveFileName, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
                ThisWorkbook.SaveAs Filename:=strSaveFileName, FileFormat:=xlOpenXMLTemplateMacroEnabled

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.

Andrew

 

Just to let you know that the code below works well for me, and thank you again. 

 

 

Command Button: -

 

  1. Generates a pdf of the ActiveSheet
  2. 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
  3. Opens Outlook and displays email with pdf attached (file with date "Now")
  4. Auto fills Recipients, reading from Cell C50
  5. 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

 

I'm very new to coding, so I wanted to add a little twist to this thread. Is it possible to have a code to convert the current spreadsheet to PDF, create an email through Outlook, but not save the document?

 

Thanks!

From what I remember it's necessary to save the document to attach the file.  However, you can save the PDF to a temporary directory and then once done using it you can just delete it:

 

It would look something like this:

 

     TempFilePath = Environ$("temp") & "\" 'This defines the filepath ---> C:\Users\username\AppData\Local\Temp
     TempFileName = "Your File Name Goes Here" 'Name File      
ActiveWorkbook.SaveAs TempFilePath & TempFileName 'Save file in Temporary Directory 'Email Workbook to people With OutMail .To = "YourName@Email.Com" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "This is the email body" 'Use "Blah Blah Blah" & Chr(13) & "This is another line" .Attachments.Add TempFilePath & TempFileName .Send End With 'Delete the Temporary File Kill TempFilePath & TempFileName

 

 

 

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

 

 

Any help will be much appreciated!

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.

 

 

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

 

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.

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

 

If your filename only consists of range O7 then you will want to make sure that it is not left blank.  If this is the only scenario where you're getting an error you may not need any complex error handling.  YOu could probably get by with something like this:

 

If Range("O7") = vbNullString Then
    MsgBox "Please fill in cell O7 which contains the filename. " _
        & "It has been left blank", vbCritical, "Error Message"
    Exit Sub
End If

 

 

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

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

 

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 :

 

Chip Pearson Error Handling

 

 

You could use WScript.Network to connect to/ test for mapped drives? (the network) 

 

https://ss64.com/vb/network.html

 

the error handler is very general and will display a message showing any code problems it catches. its up to you to decide what to do with the errors.

 

Sub emailsavePDF()

on error Goto ErrHandler

Dim objOutlook As Object
Dim objMail As Object
Dim signature As String
Dim oWB As Workbook

Set oWB = ActiveWorkbook


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


With Sheets("Estimate")

If .Range("C4") = Empty Then
MsgBox ("A customer must been selected in cell C4 and must not contain any symbols")
End
ElseIf .Range("C5") = Empty Then
MsgBox ("A trailer number must be entered in cell C5 and must not contain any symbols")
End
ElseIf .Range("C9") = Empty Then
MsgBox ("A breif repair description must be entered in Cell C9 and must not contain any symbols")
End
End If

End With



s = Range("O7").Value 'excel file name

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=s, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

PDF_File = s & ".pdf" 'pdf file name

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

ErrHandler:
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
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

 

 

Thanks Andrew

 

The below works great thanks with one exception. Is there any way if the user enters any of the following \ / : * ? ” < > |anywhere in both cell C5 or C9 a warning appears as these cells form the filename and the file cannot be saved if these symbols are contained anywhere within the text of these cells

 

Sub emailsavePDF()

Dim objOutlook As Object
    Dim objMail As Object
    Dim signature As String
    Dim oWB As Workbook
    Set oWB = ActiveWorkbook
    
    ' 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"


With Sheets("Estimate")

If .Range("C4") = Empty Then
MsgBox ("A customer must been selected in cell C4 and must not contain any symbols")
 End
 ElseIf .Range("C5") = Empty Then
 MsgBox ("A trailer number must be entered in cell C5 and must not contain any symbols")
 End
 ElseIf .Range("C9") = Empty Then
 MsgBox ("A breif repair description must be entered in Cell C9 and must not contain any symbols")
 End
 End If

End With
    
     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

 

ggg

Mark-

 

You can just error handle for that scenario by using the Replace() Function.

 

s = Replace(Replace(Replace(Range("O7"), "/", "_"), "\", "_"), ":", "_")

This will replace those special characters with an "_" which is acceptable for file names...

1 best response

Accepted Solutions
best response confirmed by Joe Gray (Copper Contributor)
Solution

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

View solution in original post