I got this from Tony towes Website. I have not tried it.
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.
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
Good Luck Jim