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

MykeD

New Member
Joined
Feb 3, 2018
Messages
8
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!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Bump
Not sure if I'm allowed to do this. Mods, please delete this post if I'm in breach
 
Upvote 0
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


Rich (BB code):
Rich (BB code):
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
 
Upvote 0
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,334
Members
452,636
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top