CODEWITHSUNDEEP
emailms-accessvba
Jerry Freeman
Jerry Freeman

Reputation: 1

Sending email to multiple email addresses from recordset

I'm trying to send email to all recipients in table.

The code is opening recordset, but when the email opens, only the last record in the recordset is showing in the "To:" field.

I used some different code based on findings here, but I'm not smart enough to make this happen.

    Dim OObj As Outlook.Application
    Dim OMsg As Outlook.MailItem
    Dim db As Database
    Dim rs As Recordset
    Dim EmailAddress As String
    Set OObj = CreateObject("Outlook.Application")
    Set OMsg = OObj.CreateItem(olMailItem)
    Set db = CurrentDb
    Set rs = db.OpenRecordset("65_EmailGroupADMIN_T")
    
    With rs
        If .EOF And .BOF Then
            MsgBox "No emails will be sent because there are no records assigned from the list", vbInformation
        Else
            Do Until .EOF
                EmailAddress = ![Email]
                .Edit
                .Update
                OMsg.To = EmailAddress
                .MoveNext
            Loop
            OMsg.Display
        End If
    End With
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    Set OMsg = Nothing
    Set OObj = Nothing

End Sub

Upvotes: 0

Views: 1276

Answers (1)

Thomas G
Thomas G

Reputation: 10206

You are erasing your TO recipient with the current EmailAddress within the loop. You should concatanate all addresses in a variable instead. Also I don't see any purpose to your rs.update and rs.edit instructions...

Do this instead:

With rs

If .EOF And .BOF Then
    MsgBox "No emails will be sent because there are no records assigned from the list", vbInformation
    Else
    EmailAddress = ""
    Do Until .EOF
        EmailAddress = EmailAddress & ";" & ![Email]
        .MoveNext
    Loop

    OMsg.To = EmailAddress
    OMsg.Display

    End If

End With

Upvotes: 1

Related Questions