Save As pdf and email with outlook

[lakeroof]

The code I have below works as I want, except
It saves the whole workbook as pdf and I would like to save only "Sheet6"
It also does not insert my signature in outlook which I need
Any help to modify this would be appreciated.

Sub Email_From_Excel_English()
    Dim emailApplication As Object
    Dim emailItem As Object
    Dim strPath As String
    Dim lngPos As Long
 
    ' Build the PDF file name
    strPath = ActiveWorkbook.FullName
    lngPos = InStrRev(strPath, ".")
    strPath = Left(strPath, lngPos) & "pdf"
    
    ' Export workbook as PDF
    ActiveWorkbook.ExportAsFixedFormat xlTypePDF, strPath
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    
    ' Now we build the email.
    emailItem.To = Range("C4")
    emailItem.Subject = "Roofing Estimate"
    emailItem.Body = "Please find attached your estimate, as well as a copy of our terms and conditions." & vbNewLine & vbNewLine & " If you have any questions, please do not hesitate to contact me." & vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine & signature
    
    ' Attach the PDF file
    emailItem.Attachments.Add strPath
    emailItem.Attachments.Add "C:\Users\Nick\Dropbox\1Nick\2022_Nick\Terms Conditions ENG.pdf"
    
    ' Send the Email
    ' Use this OR .Display, but not both together.
    emailItem.Display
    
    ' Display the Email so the user can change it as desired before sending it
    ' Use this OR .Send, but not both together.
    'emailItem.Display
    Set emailItem = Nothing
    Set emailApplication = Nothing
    ' Delete the PDF file
    Kill strPath
End Sub

 

[HaHoBe]

Hi lakeroof,

how about

Sub Email_From_Excel_English_mod()
' https://www.mrexcel.com/board/threads/save-as-pdf-and-email-with-outlook.1226032/
   Dim objAppOL As Object
   Dim objItemOL As Object
   Dim strPath As String
   Dim strBody As String

   ' Build the PDF file name
   strPath = ThisWorkbook.Path & "\Sheet6" & ".pdf"
   
   ' Export workbook as PDF
   Worksheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath
   Set objAppOL = CreateObject("Outlook.Application")
   Set objItemOL = objAppOL.CreateItem(0)
   
   ' Now we build the email.
   With objItemOL
    .Display
    strBody = .Body
    .To = Worksheets("Sheet6").Range("C4")
    .Subject = "Roofing Estimate"
    .Body = "Please find attached your estimate, as well as a copy of our terms and conditions." & _
        vbNewLine & vbNewLine & "If you have any questions, please do not hesitate to contact me." & _
        vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine & strBody
   
    ' Attach the PDF file
    .Attachments.Add strPath
    .Attachments.Add "C:\Users\Nick\Dropbox\1Nick\2022_Nick\Terms Conditions ENG.pdf"
    
    ' Send the Email
    ' Use this OR .Send, but not both together.
    .Display
   End With
   
   Set objItemOL = Nothing
   Set objAppOL = Nothing
   ' Delete the PDF file
   Kill strPath
End Sub

Ciao,
Holger

 

[DanteAmor]

Try this:

Sub Email_From_Excel_English()
  Dim emailApplication As Object
  Dim emailItem As Object
  Dim strPath As String, sBody As String
  Dim lngPos As Long
  
  ' Build the PDF file name
  strPath = ActiveWorkbook.FullName
  lngPos = InStrRev(strPath, ".")
  strPath = Left(strPath, lngPos) & "pdf"
  
  ' Export workbook as PDF
  Sheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath
  Set emailApplication = CreateObject("Outlook.Application")
  Set emailItem = emailApplication.createitem(0)
  
  ' Now we build the email.
  emailItem.To = Range("C4").Value
  emailItem.Subject = "Roofing Estimate"
  
  ' Attach the PDF file
  emailItem.Attachments.Add strPath
  emailItem.Attachments.Add "C:\Users\Nick\Dropbox\1Nick\2022_Nick\Terms Conditions ENG.pdf"
  
  ' Send the Email
  ' Use this OR .Display, but not both together.
  emailItem.Display
  
  sBody = "Please find attached your estimate, as well as a copy of our terms and conditions." & _
    vbNewLine & vbNewLine & _
    " If you have any questions, please do not hesitate to contact me." & _
    vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine
  
  emailItem.HtmlBody = sBody & emailItem.HtmlBody
  
  ' Display the Email so the user can change it as desired before sending it
  ' Use this OR .Send, but not both together.
  'emailItem.Display
  Set emailItem = Nothing
  Set emailApplication = Nothing
  ' Delete the PDF file
  Kill strPath
End Sub

 

[lakeroof]

On first I get run-time error "9"
' Export workbook as PDF
Worksheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath

Second one i get
Run time error 9
Subscript out of range at the same place

 

[DanteAmor]

It saves the whole workbook as pdf and I would like to save only "Sheet6"

Second one i get
Run time error 9
Subscript out of range at the same place

That's because you don't have a sheet in your workbook called "Sheet6".

Adjust your sheet name on this line and try again.

Sheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath

If you mean the codename then it should be like this:

Sheet6.ExportAsFixedFormat xlTypePDF, strPath

 

[lakeroof]

That's because you don't have a sheet in your workbook called "Sheet6".

Adjust your sheet name on this line and try again.


If you mean the codename then it should be like this:

Sheet6.ExportAsFixedFormat xlTypePDF, strPath

Perfect
Thank you

 

[lakeroof]

One more thing, if I may?
instead of
emailItem.Attachments.Add "C:\Users\Nick\Dropbox\1Nick\2022_Nick\Terms Conditions ENG.pdf"
Would it be possible to be able to choose a file (other users are using this file) ?

 

[DanteAmor]

Would it be possible to be able to choose a file

Try this:

Sub Email_From_Excel_English()
  Dim emailApplication As Object
  Dim emailItem As Object
  Dim strPath As String, sBody As String, secondfile As String
  Dim lngPos As Long
  
  ' Build the PDF file name
  strPath = ActiveWorkbook.FullName
  lngPos = InStrRev(strPath, ".")
  strPath = Left(strPath, lngPos) & "pdf"
  
  ' Export workbook as PDF
  Sheet6.ExportAsFixedFormat xlTypePDF, strPath
  'Sheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath
  
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select File"
    .AllowMultiSelect = False
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show Then
      secondfile = .SelectedItems.Item(1)
    End If
  End With

  
  Set emailApplication = CreateObject("Outlook.Application")
  Set emailItem = emailApplication.CreateItem(0)
  
  ' Now we build the email.
  emailItem.To = Range("C4").Value
  emailItem.Subject = "Roofing Estimate"
  
  ' Attach the PDF file
  emailItem.Attachments.Add strPath
  If secondfile <> "" Then
    emailItem.Attachments.Add secondfile
  End If
  
  ' Send the Email
  ' Use this OR .Display, but not both together.
  emailItem.display
  
  sBody = "Please find attached your estimate, as well as a copy of our terms and conditions." & _
    vbNewLine & vbNewLine & _
    " If you have any questions, please do not hesitate to contact me." & _
    vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine
  
  emailItem.HtmlBody = sBody & emailItem.HtmlBody
  
  ' Display the Email so the user can change it as desired before sending it
  ' Use this OR .Send, but not both together.
  'emailItem.Display
  Set emailItem = Nothing
  Set emailApplication = Nothing
  ' Delete the PDF file
  Kill strPath
End Sub

 

[lakeroof]

With Application.FileDialog(msoFileDialogFilePicker)
"msoFileDialogFilePicker=empty"

Runtime error '-2147467259 (80004005)':
Method FileDialog of object'_Application'failed

 

[DanteAmor]

"msoFileDialogFilePicker=empty"

I don't understand that line. Did you add it to the code?
If you didn't modify the code, then maybe it's your version of excel or office.
Try this alternative:

Sub Email_From_Excel_English()
  Dim emailApplication As Object
  Dim emailItem As Object
  Dim strPath As String, sBody As String, secondfile As Variant
  Dim lngPos As Long
  
  ' Build the PDF file name
  strPath = ActiveWorkbook.FullName
  lngPos = InStrRev(strPath, ".")
  strPath = Left(strPath, lngPos) & "pdf"
  
  ' Export workbook as PDF
  Sheet6.ExportAsFixedFormat xlTypePDF, strPath
  'Sheets("Sheet6").ExportAsFixedFormat xlTypePDF, strPath
  
  secondfile = Application.GetOpenFilename
  If secondfile = False Then
    secondfile = ""
  End If
  
'  With Application.FileDialog(msoFileDialogFilePicker)
'    .Title = "Select File"
'    .AllowMultiSelect = False
'    .InitialFileName = ThisWorkbook.Path & "\"
'    If .Show Then
'      secondfile = .SelectedItems.Item(1)
'    End If
'  End With

  
  Set emailApplication = CreateObject("Outlook.Application")
  Set emailItem = emailApplication.CreateItem(0)
  
  ' Now we build the email.
  emailItem.To = Range("C4").Value
  emailItem.Subject = "Roofing Estimate"
  
  ' Attach the PDF file
  emailItem.Attachments.Add strPath
  If secondfile <> "" Then
    emailItem.Attachments.Add secondfile
  End If
  
  ' Send the Email
  ' Use this OR .Display, but not both together.
  emailItem.display
  
  sBody = "Please find attached your estimate, as well as a copy of our terms and conditions." & _
    vbNewLine & vbNewLine & _
    " If you have any questions, please do not hesitate to contact me." & _
    vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine
  
  emailItem.HtmlBody = sBody & emailItem.HtmlBody
  
  ' Display the Email so the user can change it as desired before sending it
  ' Use this OR .Send, but not both together.
  'emailItem.Display
  Set emailItem = Nothing
  Set emailApplication = Nothing
  ' Delete the PDF file
  Kill strPath
End Sub