Sending Access Report to Different Recipients

Question

I have a report in Access that is grouped by customer with a page break after each customer so only their data is shown on the page. I would like to email the report to each customer with their individual data(page). I can get Access to email to each customer, but it emails the entire report and does not email only the specific customer. I attempted to create a Module to handle this and while it does email, it sends an email for each line of data even if it is the same customer and only sends the email text and not the details from the report. Below is the code:

Public Sub SendSerialEmail()

Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim emailTo As String
Dim emailSubject As String
Dim emailText As String

Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean

On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
    Set outApp = CreateObject("Outlook.Application")
    outlookStarted = True
End If

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Pay, Bill, Datepaid, Totalamount, Email FROM Query1")
Do Until rs.EOF

    emailTo = rs.Fields("Email").Value

    emailSubject = "YTD Transactions"

    emailText = emailText & _
                "Below is your year to date transactions."


    Set outMail = outApp.CreateItem(olMailItem)
    outMail.To = emailTo
    outMail.Subject = emailSubject
    outMail.Body = emailText
    outMail.Send


    rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

  If outlookStarted Then
    outApp.Quit
End If

Set outMail = Nothing
Set outApp = Nothing

End Sub

I have a table, query and report with Pay (customer), Bill (invoice number), Datepaid, Totalamount, Email columns.

Any help would be greatly appreciated.

Thanks

Answer 1

You might like to take a look at InvoicePDF.zip in my public databases folder at:

https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169

This little demo file includes an option to email multiple invoices to multiple customers as PDF attachments. In the demo the invoices are selected in a multi-select list box, and emailed by the code below. Each instance of the report is restricted to the invoices for a single customer by virtue of the report's RecordSource query referencing as a parameter a hidden text box in the form containing a value list of invoice numbers, using the GetToken and InParam functions published by Microsoft some years ago.

Private Sub cmdEmail_Click()

Const MESSAGE_TEXT_1 = "No invoices selected."
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strAddressee As String
Dim strTo As String
Dim strSubject As String
Dim strMessageText As String
Dim strCustomerList As String
Dim lngTo As Long
Dim lngCustomerID As Long

Dim varItem As Variant

With Me.lstInvoices
    If .ItemsSelected.Count = 0 Then
        MsgBox MESSAGE_TEXT_1, vbExclamation, "Invalid Operation"
        Exit Sub
    End If

    lngCustomerID = 0
    'loop through selected items in list box and build
    'a distinct value list of selected CustomerID values
    For Each varItem In .ItemsSelected
        If Val(.Column(2, varItem)) > lngCustomerID Then
            lngCustomerID = Val(.Column(2, varItem))
            strCustomerList = strCustomerList & "," & lngCustomerID
        End If
    Next varItem
End With

' remove leading comma
strCustomerList = Mid(strCustomerList, 2)
' establish a recordset of distinct selected CustomerID values
strSQL = "SELECT CustomerID FROM Customers WHERE CustomerID IN(" & strCustomerList & ")"
Set rst = CurrentDb.OpenRecordset(strSQL)


rst.MoveLast
rst.MoveFirst

' loop through recordset and build and open an email to each customer
Do While Not rst.EOF
    Me.txtInvoiceList = ""
    With Me.lstInvoices
        If .ItemsSelected.Count > 0 Then
            For Each varItem In .ItemsSelected
                ' if selected customer = current customer from recordset
                ' assign values to variables for use in email
                ' and increment list of invoice numbers for selected customer
                If Val(.Column(2, varItem)) = rst.Fields("CustomerID") Then
                    strAddressee = .Column(1, varItem)
                    strTo = .Column(4, varItem)
                    lngTo = .Column(2, varItem)
                    Me.txtInvoiceList = Me.txtInvoiceList & "," & .ItemData(varItem)
                End If
            Next varItem
            'remove leading comma
            Me.txtInvoiceList = Mid(Me.txtInvoiceList, 2)
            strSubject = "Invoice Numbers " & Replace(txtInvoiceList, ",", "; ")
            strMessageText = strAddressee & ":" & _
                vbNewLine & vbNewLine & _
                "The above invoices are attached." & _
                vbNewLine & vbNewLine & _
                "Customer Accounts Department, Widget Supply Company"
            ' output report as PDF file attached to email to selected customer
            DoCmd.SendObject ObjectType:=acSendReport, _
                ObjectName:="rptInvoiceMultiple_Email", _
                OutputFormat:=acFormatPDF, _
                To:=strTo, _
                Subject:=strSubject, _
                MESSAGETEXT:=strMessageText, _
                EditMessage:=True
        Else
             MsgBox MESSAGE_TEXT_1, vbExclamation, "Invalid Operation"
        End If
    End With
    rst.MoveNext
Loop

End Sub

Note that the code uses the SendObject method of the DoCmd object to generate the emails rather than opening an instance of Outlook by means of automation.