Send and Address an email using a Query Data

[elicooper]

I want to be able to send an email message to multiple managers letting
them know that their employees will be attending training.

I have a query that returns the employees that will be attending
training and their managers.

I want to loop through the query pulling the manager and all their
employees and populate the email with this data. Currently, it only
pulls the first manager in the query and adds all the employees to that
manager. Thanks in advance! See code below:



Sub SendManagerNotice(Optional AttachmentPath)

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

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset

Set db = CurrentDb
Set qdf = db.QueryDefs("qryASendManagerNotice")
qdf.Parameters(0) = _
Forms!frmClassRoster!ClassID

Set rst = qdf.OpenRecordset

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

Do Until rst.EOF
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = rst![Manager]
With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo

Dim ClassDate As String
Dim ClassTime As String
Dim ClassName As String
ClassDate = Format(Forms!frmClassRoster!ClassStartDate,
("dddd")) & _
", " & Forms!frmClassRoster!ClassStartDate
ClassTime = Forms!frmClassRoster!ClassStartTime
ClassName = Forms!frmClassRoster!CourseName

Set db = CurrentDb
Set qdf = db.QueryDefs("qryASendManagerNotice")
qdf.Parameters(0) = _
Forms!frmClassRoster!ClassID

Set rst = qdf.OpenRecordset

Dim body As String
body = ""
Do Until rst.EOF
If body = "" Then
body = "Your employees " & rst![EmployeeName]
Else
body = body & ", " & rst![EmployeeName]
End If
rst.MoveNext
Loop

.body = body

' Set the Subject, the Body, and the Importance of the e-mail
message.
.Subject = "Training Reminder - " & ClassName
' .body = TheAddress & ", " & vbCrLf & vbCrLf & "Don't forget,
you are currently scheduled for " & ClassName & " tomorrow, " &
ClassDate & " at " & ClassTime & ". " &
.Importance = olImportanceHigh 'High importance

'Add the attachment to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

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


Loop
rst.MoveNext
Set objOutlookMsg = Nothing
Set objOutlook = Nothing

End Sub