CDO Email Automation

Question

I have a MS Access 2010 db that I want to send emails from automatically. I have the query set up but am getting stuck with the CDO VBA. They query is called 'qryEmails' and contains the following 4 fields:

ReturnCode, SalesOrderNumber, Name, EmailAddress

How do I get Access to:

1. Loop through each record and send an email to each email address listed
2. In each email, have a message that will contain reference to the first 3 fields, so each message appears personalised
3. Have a dynamic subject, so the ReturnCode field is in each subject

I have been trying small steps at first, so far I am receiving 100's of emails to the same address. Here is my code (I have used XXX where I do not want to disclose info):

Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strEmail As String
Set rst = New ADODB.Recordset
'
strSQL = "[qryEmails]"  'source of recordset
rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Do While Not rst.EOF
    strEmail = rst.Fields("EmailAddress")

    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Your refund is:" '
    objMessage.FROM = """SENDER"" <[email protected]>"
    objMessage.To = rst.Fields("EmailAddress")
    objMessage.TextBody = objMessage.TextBody & rst(1)


    '==Add fields to email body
    'Do While strEmail = rst.Fields("EmailAddress")

    'rst.MoveNext
    'If rst.EOF Then Exit Do
    'Loop

' ========= SMTP server configuration 

        objMessage.Configuration.Fields.Item _
         ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

        'Name or IP of Remote SMTP Server
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "XXX"

        'Server port (typically 25)
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

        objMessage.Configuration.Fields.Update

        '==End remote SMTP server configuration section==

        'Send email
        objMessage.Send
        'Clear variable for next loop
        Set objMessage = Nothing
    Loop
rst.Close
Set rst = Nothing

Any idea why this is sending 100's of emails? The query result so far is only returning two addresses for testing purposes.

Answer 1

Within the loop, the recordset remains on the same row. And since the recordset row does not change, it never reaches rst.EOF

That code includes a disabled line for MoveNext. Uncomment that line. And you probably want to position it just before the Loop statement.

Do While Not rst.EOF
    ' do everything you need for current record,
    ' then move to the next record ...
    rst.MoveNext
Loop