export to pdf with filename from cell, then email to address from cell

[MykeD]

I've got staff timesheets that I want to export to pdf each week and then email automatically to them using Outlook

I have the filename in cell B1 on each sheet and the email address in cell E1 on each sheet

I want the pdf saved in the same folder as the spreadsheet.

I've been banging my head against the wall for a few hours trying to figure this out, but thought it was time to consult the experts.
Any help would be sincerely appreciated!

 

[MykeD]

Bump
Not sure if I'm allowed to do this. Mods, please delete this post if I'm in breach

 

[MykeD]

Ok, I've pulled the following code together which gets me halfway there, but then breaks when I try to get it to do the email bit
I get Run-time error '438': Object doesn't support this property or method
at line 27 OutlApp.Visible = True

Sub PrintPDF_ThenEmail()Dim ws As Worksheet


    Application.DisplayAlerts = True
    For Each ws In Worksheets
        If ws.Name <> "Control" And ws.Name <> "Inputs" And ws.Name <> "BarberTemplate" And ws.Name <> "RcptnTemplate" And ws.Name <> "Summary" And ws.Name <> "PayRun" And ws.Name <> "TargetActual" Then
        ws.Select
        
' Create PDF file
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ActiveWorkbook.Path & "\" & ActiveSheet.Range("B1").Value, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End If
        
      
' Use already open Outlook if possible
Dim OutlApp As Object
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True




' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)


' Prepare e-mail
.Subject = "Payslip " & ActiveSheet.Range("C5").Value
.To = ActiveSheet.Range("E1").Value
.Body = "Hi " & ActiveSheet.Range("C2").Value & "," & vbLf & vbLf _
& "Please find attached your payslip for the week ending " & ActiveSheet.Range("C5").Value & vbLf & vbLf _
& "Kind regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add ActiveWorkbook.Path & "\" & ActiveSheet.Range("B1").Value & ".pdf"


' Try to send
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If




End With
        
     Next ws
     Application.DisplayAlerts = True
        
        
End Sub

 

[MykeD]

Me again, just wondering if I'm talking to myself here
Here's an updated version of the code where I deleted some of the lines above that were causing me grief.
It now sends multiple versions of the pdf to some recipients, but I can't figure out why.
It also seem to matter which sheet I'm on when I run the macro which isn't ideal.
If anybody has feedback or thoughts on how I can improve the code and make it a bit more robust, that would be greatly appreciated.

Sub PrintPDF_ThenEmail()
Dim ws As Worksheet
 
    Application.DisplayAlerts = True
    For Each ws In Worksheets
        If ws.Name <> "Control" And ws.Name <> "Inputs" And ws.Name <> "BarberTemplate" And ws.Name <> "RcptnTemplate" And ws.Name <> "Summary" And ws.Name <> "PayRun" And ws.Name <> "TargetActual" Then
        ws.Select
       
' Create PDF file
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ActiveWorkbook.Path & "\" & ActiveSheet.Range("B1").Value, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End If
       
     
' Use already open Outlook if possible
Dim OutlApp As Object
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
 
 
 
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
 
' Prepare e-mail
.Subject = "Payslip " & ActiveSheet.Range("C5").Value
.To = ActiveSheet.Range("E1").Value
.Body = "Hi " & ActiveSheet.Range("C2").Value & "," & vbLf & vbLf _
& "Please find attached your payslip for the week ending " & ActiveSheet.Range("C5").Value & vbLf & vbLf _
& "Kind regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add ActiveWorkbook.Path & "\" & ActiveSheet.Range("B1").Value & ".pdf"
 
' Try to send
.Send
Application.Visible = True
 
 
 
End With
       
     Next ws
     Application.DisplayAlerts = True
       
       
End Sub

 

[MykeD]

bump
Can anybody help with this?