Sending Outlook emails from Access 2003 to recipients in a query

[Raymond]

Here is my code but I need to be able to email recipients from a field in a
query in the current database instead of hardcoding it like I currently have
in line: Set objOutlookRecip =
..Recipients.Add("(e-mail address removed)"). The path that I want to use
is Query!Current_Case_Query_Within_15_Days.UserID!Email. I also want to add
recipients from the same query (different field) to the cc.

Thanks is advance.

Sub SendMessage()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim clsSendObject As accSendObject

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip =
..Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olTo
objOutlookRecip.Type = olTo

' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Michael Suyama")
objOutlookRecip.Type = olCC

' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC

' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send

End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub

 

[pietlinden]

You need to open a recordset based on the query you specified...

Sub SendMessage()

Dim rsRecip as dao.recordset 'recordset to loop through query
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim clsSendObject As accSendObject

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

' Open the recordset so you can loop through it.
set rsRecip=dbengine(0)
(0).openquerydef("Current_Case_Query_Within_15_Days")

Do Until rsRecip.EOF

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip =
..Recipients.Add(rsRecip.Fields("EMail"))
objOutlookRecip.Type = olTo

' Add the CC recipient(s) to the message.
Set objOutlookRecip
= .Recipients.Add(rsRecip.Fields("CcEMail"))
objOutlookRecip.Type = olCC

' Add the BCC recipient(s) to the message.
Set objOutlookRecip
= .Recipients.Add(rsRecip.Fields("BccEMail"))
objOutlookRecip.Type = olBCC

' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft
Outlook"
.Body = "This is the body of the message." & vbCrLf &
vbCrLf
.Importance = olImportanceHigh 'High importance

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send

End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub

 

[Raymond]

Thankyou for your reply but I am getting compile errors on the following
lines, why is that:
(0).openquerydef("Current_Case_Query_Within_15_Days")

Set objOutlookRecip =
...Recipients.Add(rsRecip.Fields("EMail"))

Set objOutlookRecip
= .Recipients.Add(rsRecip.Fields("CcEMail"))

.Body = "This is the body of the message." & vbCrLf &

 

[Raymond]

Actually now I am only getting the compile error on the following line:

Set rsRecip = DBEngine(0)(0).OpenQueryDef("Current_Case_Query_Within_15_Days")