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!
885 total views, 1 views today