Here's something you may be able to adapt for your use. It generates an email for each person in tblWorkEmail and supports attachments.
Code:
Sub subOutlookEmailOption_6()
Const olMailItem As Long = 0
if MsgBox("This option uses Microsoft Outlook to email members " _
& "with a personalized message." , 49, " S E N D B U L K E M A I L ") = vbcancel then
exit sub
end if
Dim intCtr as Long
Dim strTo As String
Dim strbody As String
Dim strFirst As String
Dim strNLMO As String
Dim strSender As String
Dim strAttach As String
Dim strSubject As String
Dim I as Long
Dim rst as DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblWorkEmail", dbOpenSnapshot)
With rst
If .RecordCount > 0 Then
.MoveLast
.MoveFirst
End If
End With
strAttach = fcnBrowse("File") 'fcnBrowse calls file dialog and returns the path/filename
If Len(strAttach & vbNullString) = 0 Then
strAttach = "NONE"
Else
intMsgBox = MsgBox("The attachment will be:" & vbCrLf & strAttach & Space(5), _
vbOKCancel, "E m a i l A t t a c h m e n t")
If intMsgBox = vbCancel Then Exit Sub
End If
'strbody = DLookup("emBodyText", "tblEmailOptions", "emOptionNo = " & arg)
'strSender = DLookup("emSender", "tblEmailOptions", "emOptionNo = " & arg)
For I = 1 To rst.RecordCount
strSubject = "Your " & rst!NLMO & " Newsletter"
strTo = rst!ME_MAIL1
strNLMO = rst!NLMO
strFirst = rst!First
Dim olApp As Object
Dim newMail As Object
Dim olAttachment As Object
Set olApp = CreateObject("Outlook.application")
Set newMail = olApp.CreateItem(olMailItem)
Set olAttachment = newMail.Attachments
If Not IsNull(strAttach) Then
If strAttach <> "NONE" Then
olAttachment.Add strAttach
End If
End If
Set newMail.sendusingaccount = olApp.session.accounts.Item(fcnGetSetupUserData(2))
With newMail
.To = strTo
.subject = strSubject
.body = "Dear " & strFirst & "," & vbCrLf & vbCrLf & strbody
If I = 1 Then
MsgBox "Make sure Outlook is running before proceeding..."
.Display : intCtr = intCtr + 1
Else
.Send : intCtr = intCtr + 1
End If
'Debug.Print I & ". " & strTo & " with " & strAttach
End With
Set newMail = Nothing
rst.MoveNext
Next I
MsgBox "Finished sending mail to Outlook." & vbCrLf _
& intCtr & " emails sent", vbOKOnly, " C O M P L E T E D "
end sub