Now you can use the following code to test. It will use your Missions2 table. Any Email address in Missions2 table will receive a report. This will go in the click event of your button.
Code:
'Declare variables and assign values
Dim strReportName As String
Dim strPath As String
Dim strFullPath As String
Dim strEmailAddress As String
Dim strSubject As String
Dim strBody As String
strReportName = "All Payments to Partners"
strEmailAddress = ""
strSubject = "This is my report"
strBody = ""
'before exporting your report you will want to make
'sure there is not a file in the folder with the same name
'and that the folder actually exists
strPath = manageTempFolder
strFullPath = strPath & "\" & strReportName & ".pdf"
'Bail if there is a problem with the directory
If strPath = "" Then
Exit Sub
End If
'We will use the query object as the recordsource of the Report.
'and assign dynamic SQL to the QueryDef
Dim strQueryName As String
strQueryName = "All Payments to Partners"
'Use DAO to open a recordset and iterate
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qryDef As DAO.QueryDef
Dim strSQL As String
Dim strWhere As String
Dim strOrderBy As String
strSQL = "SELECT [Prefix] & ' ' & [Full Name (Exc Prefix)] AS Partner, " & _
"[Non-Cheque Payments].[Date], [Non-Cheque Payments].[Amount], [Missions].[E-mail address], " & _
"[Non-Cheque Payments].Code " & _
"FROM [Non-Cheque Payments] INNER JOIN [Missions] ON [Non-Cheque Payments].Code = [Missions].Code "
strWhere = "WHERE ([Non-Cheque Payments].Code NOT IN ('CONEX', 'PAYPA', 'FLOAT', 'WEC')) "
strOrderBy = "ORDER BY [Prefix] & ' ' & [Full Name (Exc Prefix)], [Non-Cheque Payments].[Date];"
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT DISTINCT Missions2.Code, Missions2.[E-mail address] FROM Missions2", dbOpenSnapshot)
Set qryDef = db.QueryDefs(strQueryName)
rs.MoveFirst
'Use early binding to create an email
Dim objOutlook As New Outlook.Application
Dim objNewEmail As MailItem
Dim objAttachReport As Attachments
While rs.EOF = False
'WHERE (((Missions.Code)="AIM"))
strEmailAddress = rs![E-mail address]
strBody = "Dear " & rs![ReplaceWithFieldName] & ":<br><br>Please find a copy of my report attached here."
strWhere = strWhere & "AND [Missions].Code = '" & rs![ReplaceWithFieldName] & "' "
qryDef.SQL = strSQL & strWhere & strOrderBy
'create a report in the temp folder
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFullPath
'Instantiate your objects
Set objNewEmail = objOutlook.CreateItem(olMailItem)
Set objAttachReport = objNewEmail.Attachments
'Add your file to the Attachments Collection
objAttachReport.Add strFullPath, olByValue
With objNewEmail
.BodyFormat = olFormatRichText
.To = strEmailAddress
.Subject = strSubject
.HTMLBody = strBody
'Save the email to ensure the attachment is a
'copy of the original file (olByValue)
.Save
.Send
End With
'' 'Delete the report you just emailed
Kill strFullPath
'Reset the Attachments collection
'Using the collection is useful when there is more
'than one attachnebnt per email
Set objNewEmail = Nothing
Set objAttachReport = Nothing
'Rinse and repeat
rs.MoveNext
'Close the loop
Wend 'rs.EOF now is True
'tidy up
Set objAttachReport = Nothing
Set objNewEmail = Nothing
Set objOutlook = Nothing
qryDef.SQL = strSQL
Set qryDef = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
MsgBox "Complete"
Need help with VB to send multiple emails
Windows 8 
Access 2013
Reply With Quote
Originally Posted by Baldeagle
