Sending a Query to multiple recipients in 1 e-mail

[driver7408]

I am really new to VBA; having gotten by designing most of my database with macros so far.

I have a query that I designed that pulls up a list of people and their email addresses, as well as 4 other fields of information. The query has no Nulls anywhere. I need to send an email through Outlook occasionally when the query gets updated. I have a button assigned to do that. I need it to send the email to all of the people in the query at once, and combine all of their names in the 'To' field, separated by commas. I need the information from the 4 fields to go into the email. I don't care if the security box pops up once to allow sending the email, nor do I care if instead it just opens up outlook with the email ready to be sent.

The closest code I could find worked great, except the user has to click on the security permission for each email, because it was sending a separate email to each person, rather then combining all the recipients in the 'To' field.

I cannot download any add-ons to do this due to admin security constraints on our network.

Is there any way to modify this code to make it send the email in the manner in which I need it to?



Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String

Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("EmailQuery", dbOpenSnapshot)

With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(.Fields(5)) = False Then
sToName = .Fields(5)
sSubject = "You have a new file waiting"
sMessageBody = "The File"&.Fields(2)&"is now available."&vbCrLf_
&"Date: "&.Fields(3)&vbCrLf_
&"Location: "&.Fields(4)

DoCmd.SendObject acSendNoObject, , , _
sToName, , , sSubject, sMessageBody, False, False
End If
.MoveNext
Loop
End With

Set MyDb = Nothing
Set rsEmail = Nothing

 

[pbaldy]

Move the actual sending of the email after the loop. Within the loop, build a string of all the recipients:

sToName = sToName & .Fields(5) & ";"

 

[vbaInet]

The SendObject is limited, what you want is Outlook Automation.

Use the Search facility on the forum, there are lots of threads regarding this.

Edit: Paul, always beating me to it.

 

[driver7408]

Still kind of confused how to move it out of the loop. I've been messing with it for 5 hours now and not getting anywhere. Keep in mind I'm a complete newbie to VBA. I think there is some way to do it within Access, although I've found many unanswered threads on this topic. I did find some code that sends the email to multiple people at once, but nothing that does both that, and includes the chosen fields from my query.

 

[stopher]

Take a look at this. See how the SendObject line is no longer in the loop. Also see sToName = sToName & .Fields(5). In order words, each time we loop we add the string to itself as well as adding the new recipient. The same goes for your message body. The only thing with the message body is that I've put another vbCrLf on the end otherwise each "record" will appear as one big block - not pretty.

Also note how I've indented blocks inside loops and IF statements. This makes the code a lot easier to read.

Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String

Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("EmailQuery", dbOpenSnapshot)

sSubject = "You have a new file waiting"

With rsEmail
.MoveFirst
Do Until rsEmail.EOF
    If IsNull(.Fields(5)) = False Then
        sToName = sToName & .Fields(5)
        sMessageBody = sMessageBody & "The File" & .Fields(2) & "is now available." & vbCrLf _
        & "Date: " & .Fields(3) & vbCrLf _
        & "Location: " & .Fields(4) & vbCrLf
    End If
    .MoveNext
Loop
End With

DoCmd.SendObject acSendNoObject, , , _
sToName, , , sSubject, sMessageBody, False, False

Set MyDb = Nothing
Set rsEmail = Nothing

hth
Chris