question

KevinHyder-7228 avatar image
0 Votes"
KevinHyder-7228 asked KenSheridan-7466 edited

Sending Access Report to Different Recipients

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

office-access-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

1 Answer

KenSheridan-7466 avatar image
0 Votes"
KenSheridan-7466 answered KenSheridan-7466 edited

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.

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.