Recordset Problem

[Novice1]

I'm trying to send out several e-mails using a recordset. I'm trying to piecemeal code without much luck. Any help would be appreciated.


On Error GoTo Error_Handler

Dim OLApp As Outlook.Application
Dim OLMsg As Outlook.MailItem

Set OLApp = New Outlook.Application
Set OLMsg = OLApp.CreateItem(olMailItem)


Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim iCount as Integer

db = CurrentDb()
Set rs = db.OpenRecordset("qryPCSTrackerWithin120Days") 'open the recordset for use (table, Query, SQL Statement)

With rs
If .RecordCount <> 0 Then
rs.MoveLast
iCount = rs.RecordCount

Do While Not .BOF

With OLMsg
.Display
.To = [SubjectEMail]
.CC = "" & "; " & ""
.Subject = "Initial Assignment Notification"
.ReadReceiptRequested = True
.Body = "..."

Set OLMsg = Nothing
Set OLApp = Nothing


.MovePrevious
Loop
End If
End With

rs.Close 'Close the recordset

Error_Handler_Exit:
On Error Resume Next
'Cleanup after ourselves
Set rs = Nothing
Set db = Nothing
Exit Sub

Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: LoopRecExample" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit

 

[pbaldy]

First of all, you should send or display it. Second, you're setting your email variables to nothing inside the loop, so at best you'd only get one email sent. Third, the setting of the email item needs to be inside the loop, since you want a new email each time.