eMailing specific Reports to specific Recipients…

Question: Can anyone tell me how to eMail a report with content based data based on the individual?

Answer:
Create a Module, name it anything you like except the name of the Function.

At the top of your Module under…

Option Compare Database
Option Explicit

…place

Public olApp As Object
Public olNameSpace As Object
Public objRecipients As Object
Public objNewMail As Object 'Outlook.MailItem

Then, we need something to initialize Outlook, so, copy/paste the below into the same Module…

Function InitializeOutlook() As Boolean
' This function is used to initialize the global Application and
' NameSpace variables.
    
    On Error GoTo Init_Err
    Set olApp = CreateObject("Outlook.Application", "LocalHost")  ' Application object
    Set olNameSpace = olApp.GetNamespace("MAPI")  ' Namespace object
    Set objNewMail = olApp.CreateItem(0)
    InitializeOutlook = True
Init_Bye:
    
    Exit Function
Init_Err:
    InitializeOutlook = False
    Resume Init_Bye
    
End Function

And now we can copy/paste the Function into the same Module…
Note: After you have copied it you will need to change the Paths, Query, Report and Field Names to match your own.

Function streMailOverdue() As String
On Error GoTo Error_Proc
‘From: https://regina-whipp.com/blog/ 
    
    DoCmd.Hourglass True
    
    'Set global Application and NameSpace object variables, if necessary.
    If olApp Is Nothing Then
        If InitializeOutlook = False Then
            MsgBox "Unable to initialize Microsoft Outlook!"
        End If
    End If
    
    'Create new MailItem object.
    Set objNewMail = olApp.CreateItem(0)
    
    Dim strTo As String
    Dim strSQL As String
    Dim rs As Recordset
    Dim strSubject As String
    Dim strBody As String
    Dim strAttachment As String
    
    'Get the eMails for those who are to receive a Report
    strSQL = "SELECT apAssociateID, apeMailAddress " & _
                "FROM qryeMailAddresses"

    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    'Save Report outside Access
    With rs
        .MoveFirst
            Do While Not .EOF
                DoCmd.OutputTo acOutputReport, "rpteMailReport", acFormatPDF, "\\SERVERNAME\data\eMailReports\" & !apAssociateID & "-ToDoListFor_" & Format(Date, "mm.dd.yyyy") & ".pdf"
                strAttachment = "\\SERVERNAME\data\eMailReports\" & !apAssociateID & "-ToDoListFor_" & Format(Date, "mm.dd.yyyy") & ".pdf"
            'Send eMail and Report
            Set objNewMail = olApp.CreateItem(0)
            With objNewMail
                .To = rs.Fields("apeMailAddress")
                .Subject = "To Do List Items Overdue!"
                .Body = "See attachment..."
                    If strAttachment <> "" Then
                        .Attachments.Add strAttachment
                    End If
                .Send
            End With
        .MoveNext
        Loop
            'Delete the Reports
            If Dir("\\SERVERNAME\data\eMailReports\*.pdf") <> "" Then
                Kill "\\SERVERNAME\data\eMailReports\*.pdf"
            End If
        End With
        
        rs.Close
        Set rs = Nothing
    
Exit_Proc:
    DoCmd.Hourglass False
    Exit Function
Error_Proc:
    Select Case Err.Number
        Case 287:
          'On Error Resume Next
          Resume Exit_Proc 'ignore the error'
        Case Else:
          MsgBox "Error encountered streMailOverdue: " & Err.Description
          Resume Exit_Proc 'display a message then exit'
    End Select

End Function

Now, on your Form in the Event Procedure of your Command Button place…

Call eMailOverdue

All done!

 793 total views,  1 views today