Sample Code illustrating looping through a DAO recordset

This code is attached to a command button on a form. On the form are the fields txtProgress which displays various messages as well as lblStatus which displays a record count of the progress.

Also see ACC97: How to Use a Recordset to Send Outlook E-Mail to Multiple Recipients - 318881

   On Local Error GoTo Some_Err
    
    Dim MyDB As Database, RS As Recordset
    Dim strBody As String, lngCount As Long, lngRSCount As Long
    
    DoCmd.RunCommand acCmdSaveRecord
    Set MyDB = DBEngine.Workspaces(0).Databases(0)
    
    Me!txtProgress = Null

   Set RS = MyDB.OpenRecordset _
      ("Email - Outstanding Promos")
    lngRSCount = RS.RecordCount
    If lngRSCount = 0 Then
      MsgBox "No promo email messages to send.", vbInformation
    Else
      RS.MoveLast
      RS.MoveFirst
      Do Until RS.EOF
        lngCount = lngCount + 1
        lblStatus.Caption = "Writing Message " & CStr(lngCount) _
          & " of " & CStr(lngRSCount) & "..."
        strTo = RS!cEmailAddress
        intMessageID = Year(Now) & Month(Now) & Day(Now) & Fix(Timer) & "_MabryMail"

        ' Send the email using some technique or other

        RS.Edit
        RS("cpeDateTimeEmailed") = Now()
        RS.Update
        RS.MoveNext
      Loop
    
    End If
    RS.Close
    MyDB.Close
    Set RS = Nothing
    Set MyDB = Nothing
    Close
    
    Me!txtProgress = "Sent " & CStr(lngRSCount) & " emails."
    lblStatus.Caption = "Email disconnected"
    MsgBox "Done sending Promo email. ", vbInformation, "Done"
    lblStatus.Caption = "Idle..."
    Exit Sub
    
Some_Err:
    'MousePointer = 0
    MsgBox "Error (" & CStr(Err.Number) & ") " & Err.Description, _
        vbExclamation, "Error!"
    lblStatus.Caption = "Email disconnected"

For corrections or additional information email Tony Toews

[ Email | Access | Main ]