VBA - Export sheet as PDF and attach to email

[Melimob]

Hi there

I searched around and found some code that almost works. I keep getting and error on the 'Attach file' line.

I basically have a pivot on a sheet which is filtered by employee.
Each month I need to refresh pivot, and for each employee, export their results as a PDF to email to them.

It has to be individual email per employee (they can't see each others results).

Cell D3 is ="C:\Users\abcedef\Documents\Mike Test"&"Monthly Commission_"&B3&"_"&TEXT(I3,"MMM-YY")&".PDF"
Cell I3 is todays date
Cell B3 is the employee name in pivot filter
Cell A1 is the employee email (this is a lookup on B3)

Sub emailsavePDF()


Dim objOutlook As Object
    Dim objMail As Object
    Dim signature As String
    Dim oWB As Workbook
    Set oWB = ActiveWorkbook
    Dim PDF_File As String
    
    
    
     s = Range("D3").Value
  
 '
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         s, Quality:=xlQualityStandard, IncludeDocProperties _
         :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         
         
    PDF_File = Range("D3").Value & ".pdf"
 
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
        
    With objMail
        .display
    End With
        signature = objMail.HTMLbody
    With objMail
        .To = Range("A1").Value
        .Subject = "Monthly Commissions for " & Range("b3").Value
        .HTMLbody = "****** style=font-size:11pt;font-family:Calibri>Hi;<p>Please find attached monthly commissions " & 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

Many thanks for any advice!
Kind regards
Mel

 

[yky]

What is the error message?

D3 already contains file extension ".PDF". Why append another ".PDF" to PDF_Name? The file name now has an extension of ".PDF.PDF."

 

[Melimob]

Great thanks yky! I knew it would be something simple and that solved the issue.

What is the error message?

D3 already contains file extension ".PDF". Why append another ".PDF" to PDF_Name? The file name now has an extension of ".PDF.PDF."

Unfortunately, I now have another issue..
the below works great however the signature is all messed up. I think it's because of the HTML line perhaps but unsure how to fix?

Sub emailsavePDF()


Dim objOutlook As Object
    Dim objMail As Object
    Dim signature As String
    Dim oWB As Workbook
    Set oWB = ActiveWorkbook
    Dim PDF_File As String
    
    
    
     s = Range("b1").Value
  
 '
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         s, Quality:=xlQualityStandard, IncludeDocProperties _
         :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         
         
    PDF_File = Range("b1").Value
 
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
        
    With objMail
        .display
    End With
        signature = objMail.HTMLbody
    With objMail
        .To = Range("A1").Value
        .Cc = "test@test.co.uk"
        .Subject = "Monthly Commissions for " & Range("b2").Value
        .Body = "Hi " & Range("B2").Value & "," _
                      & vbNewLine & vbNewLine & _
                      "Please find attached your monthly commission statement for " & Range("I3").Value _
                      & vbNewLine & vbNewLine _
                      & "Any questions please do not hesitate to ask." _
                      & vbNewLine & vbNewLine _
                      & "Kind Regards, Lindsay" _
                      & vbNewLine _
                      & signature
        .Attachments.Add PDF_File
        .Save
        .display
    End With
    '_




    Set objOutlook = Nothing
    Set objMail = Nothing
End Sub

Many thanks

 

[yky]

What exactly is signature (or objMail.HTMLbody) and how is the signature file "messed up"?