Some time ago I received help to send multiple emails by scrolling through a table and identifying those selected in order to send emails. I need to modify this code but am a rookie when it comes to VB!
I have made some minor changes to the code that I had but I need some guidance as to how I can send an email with an attached report containing information which is specific to each of the recipients. I have created a Report called 'All Payments to Partners' which has about 30 individual pages each of which contains the information which is specific to the individual partners. This report is based on a Query with the same name which contains 4 fields including one called 'E-mail address'.
What modifications do I need to make to the following code to achieve my objective? I think the black sections are OK but I need help with what should replace the red section.
Code:
Private Sub Command88_Click()
Dim varItem As Variant 'Selected items
Dim strWhere As String 'String to use as WhereCondition
Dim strDescrip As String 'Description of WhereCondition
Dim lngLen As Long 'Length of string
Dim strDelim As String 'Delimiter for this field type.
Dim strDoc As String 'Name of report to open.
Dim db As Database
Dim rs As DAO.Recordset
Dim ToVar As String
Dim sql As String
Dim strEmail As String
strDelim = """" 'Delimiter appropriate to field type.
strDoc = "All Payments to Partners"
DoCmd.SetWarnings False
'Loop through the ItemsSelected in the list box.
With Me.lstCategory
For Each varItem In .ItemsSelected
strWhere = ""
strDescrip = ""
If Not IsNull(varItem) Then
'Build up the filter from the bound column (hidden).
strWhere = strWhere & strDelim & .ItemData(varItem) & strDelim & ","
'Build up the description from the text in the visible column.
strDescrip = strDescrip & """" & .Column(0, varItem) & """, "
strEmail = """" & .Column(1, varItem) & ""
End If
'Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere) - 1
If lngLen > 0 Then
strWhere = "[Name of Mission] IN (" & Left$(strWhere, lngLen) & ")"
lngLen = Len(strDescrip) - 2
If lngLen > 0 Then
strDescrip = "Email: " & Left$(strDescrip, lngLen)
End If
End If
'Report will not filter if open, so close it.
If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If
DoCmd.OpenReport strDoc, acViewPreview, WhereCondition:=strWhere, OpenArgs:=strDescrip
DoCmd.SendObject acSendReport, strDoc, acFormatPDF, strEmail, , , "Receipt Request", "Attached is a request for an acknowledgement for all moneys received through iMap in the past year.", True
DoCmd.Close acReport, strDoc
Next
End With
DoCmd.Close acReport, strDoc
DoCmd.SetWarnings True
End Sub