Access Control : Sample Code illustrating looping through a DAO recordset

Ref: http://www.granite.ab.ca/access/email/recordsetloop.htm

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 ]

Thanks and regards,

Victor LEUNG

(CS2)

Office: 2300 6473

Pager: 7472 8296

Internet mail: lkc321@ha.org.hk

***************************************************************************
Disclaimer

This Email may contain privileged and confidential information and is solely for the use of the intended recipient. If you are not the intended recipient, you must not print, copy, distribute or take any action in reliance on it. If you have received this Email by mistake, please notify the sender and then delete this Email from your computer. The Hospital Authority does not accept liability arising from Email transmitted by mistake.

Although this Email and any attachments are believed to be free of virus or other defects that might affect any computer system into which it is received and opened, it is the responsibility of the recipient to ensure that it is virus free, and no responsibility is accepted by the Hospital Authority for any loss or damage in any way arising from its use.

All views or opinions expressed in this Email and its attachments are those of the sender and do not necessarily reflect the views and opinions of the Hospital Authority.
***************************************************************************