Search code examples
vbams-accessms-access-2016

Export access report as pdf and attach to Outlook email using VBA

I have an Employees database that creates (among other things) monthly payrolls and individual payslips. Individual payslip is a report based on a query that does all filtering (month, employee), picking input parameters from an unbound form with month and employee fields.

enter image description here

The payslip report opens in Report View (not Print Preview) and has a single command button on it that saves report in PDF format to a specific folder, initiates Outlook and formats email message (To, subject, body, etc...).

enter image description here

So far so good - the command button does save report in PDF format to a specified folder, properly names it, opens Outlook email, formats the email properly... but, there is no attachment!

enter image description here

Here is the code behind the report's command button:


Option Compare Database
Option Explicit

Private Sub cmdEmailPayslip_Click()

On Error GoTo cmdEmailPayslip_Error
    
Dim O As New Outlook.Application
Dim M As Outlook.MailItem
Dim Msg As String
Dim aTextBody As String
Dim myPath As String
Dim myFile As String
Dim mySubject As String

    mySubject = Me.FirstName.Column(1) & " " & Me.LastName.Column(1) & _
    " - Payslip for " & Format$(Forms!fSF!SFrom, "mmmm yyyy")
    
    aTextBody = "Dear " & Me.FirstName.Column(1) & "," & _
    Chr(10) & Chr(10) & "Please find attached your payslip for the month of " & _
    Format$(Forms!fSF!SFrom, "mmmm yyyy") & _
    Chr(10) & Chr(10) & "Best regards," & _
    Chr(10) & Chr(10) & "CIVIC EA OPS Team!"

    myPath = "C:\Payroll PESA\Payslips"
    
    myFile = Format$(Date, "yyyymmdd") & " - " & Me.FirstName.Column(1) & " - Payslip for " & Format$(Forms!fSF!SFrom, "mmmm yyyy")
    
    DoCmd.OutputTo acOutputReport, "rPayslips", acFormatPDF, myPath & "\" & myFile & ".pdf", False
    
Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)
    
On Error Resume Next

With M
    .Body = aTextBody                                    'Set body text
    .To = Me.REmail                                      'Set email address
    '.Cc = ""                                            'Set email CC address
    .Subject = mySubject                                 'Set subject
    .Attachment.Add myPath & "\" & myFile
    .Display
End With

Set M = Nothing
Set O = Nothing

'Show message
MsgBox "The email message has been sent successfully.  ", vbInformation, "EMail message"

cmdEmailPayslip_Error:
    Resume Next

End Sub

I tried quite a number of permutations, but it didn't work.

What am I doing wrong?

Many thanks in advance.

Maybe I shall change my approach and try creating individual PDF payslips (and saving them to specified folder, with proper names of each PDF file, then creating set of individual emails each containing specific payslip as attachment) by going through recordset - but this is beyond my understanding...

Solution

  • You save your report as

    myPath & "\" & myFile & ".pdf"

    but try to add this attachment:

    myPath & "\" & myFile

    If you wouldn't run this code after On Error Resume Next (and if your error handler would consist of more than Resume Next), it would show you a "cannot open file" error.

    In all cases like this, where you create a file and later use it, it is always a good idea to store the full file path\name in a variable, so that errors like this cannot happen.

    sFullPath = myPath & "\" & myFile & ".pdf"
DoCmd.OutputTo acOutputReport, "rPayslips", acFormatPDF, sFullPath, False
'...
.Attachment.Add sFullPath

    P.S. and in Explorer, turn off the "hide file extensions for known file types" setting. This only leads to confusion.