Sending 1 email to a recordset instead of 1 email per record

[VbPanicStation]

Hi all,
I hope that you can help me. I've only just started programming and I am struggling.
I have modified the code below (that I copied out of a VBA Book) to send one email per record in a query. Now I would like to modify it again such that it send one email to all the people in the query/ record set. I have got the program counting the number of records in the recordset but that's as far as I've got. Any help will be greatly appreciated. I am using VBA in access 2000 & outlook 2000. The code I have got so far is as follows:

Public Sub ReOrder1()

    Dim db          As Database                 ' current database
    Dim recAssigned  As Recordset                ' recordset of items to order
    Dim objOutlook  As New Outlook.Application  ' outlook object
    Dim objMessage  As MailItem                 ' outlook mail message
    Dim strSQL      As String                   ' sql string
    Dim strOrder    As String                   ' string of order details
    Dim strItems    As String                   ' just the order items
    Dim strEmailAdd    As String                   ' just the order items
     Dim strCount As Integer                    'count
       
       
    Set db = CurrentDb()
       
      'query holding relevant information only
      Set recAssigned = db.OpenRecordset("qryEmailPeopleWhoHaveBeenAssignedDcr")

    ' now loop through the the query to get all names, email addresses etc
        While Not recAssigned.EOF
       
        'record count
        strCount = recAssigned.RecordCount
        'MsgBox strCount
        
        ' gets email addresses from the query
        strEmailAdd = recAssigned("EmailAdd")
        
        ' define body for email
          strOrder = recAssigned("Name") & _
                vbCrLf & vbCrLf & _
            "PUT THE BODY OF THE EMAIL MESSAGE IN HERE"
                
                ' skip those people without an email address
            If Not IsNull(recAssigned("EmailAdd")) Then
          ' now create the mail message
           Set objMessage = objOutlook.CreateItem(olMailItem)
            With objMessage
                .To = strEmailAdd
              .Subject = "New Order"
                .Body = strOrder
              .Send
           End With
            recAssigned.MoveNext
            End If
         Wend
   
    ' tidy up
      recAssigned.Close
    Set recAssigned = Nothing
    Set objOutlook = Nothing
    Set objMessage = Nothing

End Sub

Thanks
K

 

[scclem]

K,

Something along this line should work.

Public Sub ReOrder1()

Dim db As Database ' current database
Dim recAssigned As Recordset ' recordset of items to order
Dim objOutlook As New Outlook.Application ' outlook object
Dim objMessage As MailItem ' outlook mail message
Dim objOutlookRecip As Outlook.Recipient 'recipients object to hold all receivers email addresses.
Dim strSQL As String ' sql string
Dim strOrder As String ' string of order details
Dim strItems As String ' just the order items
Dim strEmailAdd As String ' just the order items
Dim strCount As Integer 'count


Set db = CurrentDb()

'query holding relevant information only
Set recAssigned = db.OpenRecordset("qryEmailPeopleWhoHaveBeenAssignedDcr")

'define body for email
strOrder = recAssigned("Name") & _
vbCrLf & vbCrLf & _
"PUT THE BODY OF THE EMAIL MESSAGE IN HERE"

' now create the mail message
Set objMessage = objOutlook.CreateItem(olMailItem)

With objMessage

.Subject = "New Order"
.Body = strOrder

'Now loop through the the query to get all names, email addresses etc

Do While Not recAssigned.EOF


If Not IsNull(recAssigned("EmailAdd")) Then

' gets email addresses from the query and add to Recipients object
Set objOutlookRecip = .Recipients.Add(recAssigned("EmailAdd"))
'Set recipient object to the mail items "To" listing
objOutlookRecip.Type = olTo

End If

Loop

.Send

End With


' tidy up
recAssigned.Close
Set recAssigned = Nothing
Set objOutlook = Nothing
Set objMessage = Nothing

End Sub