title: CDO Email Automation
body: <p>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:</p>
  
  <pre><code>ReturnCode, SalesOrderNumber, Name, EmailAddress
  </code></pre>
  
  <p>How do I get Access to:</p>
  
  <ol>
  <li>Loop through each record and send an email to each email address listed</li>
  <li>In each email, have a message that will contain reference to the
  first 3 fields, so each message appears personalised</li>
  <li>Have a dynamic subject, so the <code>ReturnCode</code> field is in each subject</li>
  </ol>
  
  <p>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):</p>
  
  <pre><code>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"" &lt;XXX@somewhere.com&gt;"
      objMessage.To = rst.Fields("EmailAddress")
      objMessage.TextBody = objMessage.TextBody &amp; 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
  </code></pre>
  
  <p>Any idea why this is sending 100's of emails?  The query result so far is only returning two addresses for testing purposes.</p>