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