How does this look?
Code:
Option Compare Database
Option Explicit
Sub SendMessages(Optional AttachmentPath)
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblMailingList")
MyRS.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRS.EOF
'Filter report to display only Supplier currently showing on FORM_NAME
DoCmd.OpenReport "REPORT_NAME", acViewPreview, , "OFFICE_ID = " & OFFICE_ID
'This outputs the filtered report in .RTF format to temporary location.
strFileName = "REPORT_NAME" & Me.OfficeName & Format(Date, "yyyymmdd")
DoCmd.OutputTo acOutputReport, "REPORT_NAME", acFormatPDF, "C:\FILE\PATH\" & strFileName & ".rtf"
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![Email Address]
With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
' Add the Cc recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add("EMAIL_ADDRESSES_GO_HERE")
objOutlookRecip.Type = olCC
' Set the Subject, the Body, and the Importance of the e-mail message.
.Subject = "Testing Mass Emails"
.Body = "Testing body text"
'Add the attachment to the e-mail message.
Set objOutlookAttach = .Attachments.Add("C:\FILE\PATH\" & strFileName & ".rtf")
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub