Loop not reading last record in Query

[abenny]

I have a query already created in my database which pulls from 3 different tables PRF, Employee & Vendors.
When i try to run the Loop below it gives me an error on the 2nd .MoveNext and says there are no current records. Which I understand but the problem is that it leaves the last record out of the email being sent all other invoices in the query are included in the emails. What needs to be done to include that last record?

Public Sub SendMail1()
 Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSubject As String
Dim strEmailAddress As String
Dim strEMailMsg As String
Dim ingCounter As Integer
Dim intCount As Integer
Dim aOutlook As Object
Dim aEmail As Object
Dim mySQL As String
 
 
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Email")
 'Count of unsent e-mails
intCount = DCount("[ID]", "[PRF]" _
, "[Notified]=0")
'If count of unsent e-mails is zero then the procedure will not run
'If count of unsent e-mails is greater than zero, msgbox will prompt
'to send mail.
     If intCount = 0 Then
        MsgBox ("You have " & intCount & " emails to send.") _
        , vbInformation, "Posted PRF"
        Exit Sub
    Else
 
rst.MoveFirst
Do While rst.EOF = False
'If rst.EOF = True Then Exit Do
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    strEmailAddress = rst![EmployeeEmail]
    aEmail.To = strEmailAddress
        Do While rst![EmployeeEmail] = strEmailAddress
         With aEmail
         .Display
         End With
         signature = aEmail.Body
         aEmail.Subject = "Posted payment Request"
         aEmail.Body = "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & _
         vbNewLine & signature
         rst.MoveNext
         If rst.EOF Then Exit Do
        Loop
     aEmail.Send
     'If rst.EOF Then Exit Do
    rst.MoveNext
 
Loop
    End If
 
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
'Run update to update the sent mail check box
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE PRF SET PRF.Notified = -1 WHERE (((PRF.Notified)=0))"
    DoCmd.SetWarnings True
    MsgBox "All new emails have been sent for posted PRF", vbInformation, "Thank You"
End Sub

[jforbes]

I would try something like the following instead:

Do While Not rst.EOF
    If rst![EmployeeEmail] = strEmailAddress Then
        aEmail.Display
        signature = aEmail.Body
        aEmail.Subject = "Posted payment Request"
        aEmail.Body = "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & vbNewLine & signature
    End If
    rst.MoveNext
Loop

This way, there is only one way out of the Loop, after everything has been accomplished.

[abenny]

That reads all the records but puts each invoice in an individual email instead of one per Employee with multiple invoice lines

[jforbes]

What does your code look like now?

[abenny]

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Email")
 'Count of unsent e-mails
intCount = DCount("[ID]", "[PRF]" _
, "[Notified]=0")
'If count of unsent e-mails is zero then the procedure will not run
'If count of unsent e-mails is greater than zero, msgbox will prompt
'to send mail.
     If intCount = 0 Then
        MsgBox ("You have " & intCount & " emails to send.") _
        , vbInformation, "Posted PRF"
        Exit Sub
    Else
 
rst.MoveFirst
Do While rst.EOF = False
 
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    strEmailAddress = rst![EmployeeEmail]
    aEmail.To = strEmailAddress
        If rst![EmployeeEmail] = strEmailAddress Then
         aEmail.Display
         signature = aEmail.Body
         aEmail.Subject = "Posted payment Request"
         aEmail.Body = "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & _
         vbNewLine & signature
         End If
         If rst.EOF Then Exit Do
        'Loop
     aEmail.Send
    rst.MoveNext
Loop
    End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

[abenny]

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Email")
 'Count of unsent e-mails
intCount = DCount("[ID]", "[PRF]" _
, "[Notified]=0")
'If count of unsent e-mails is zero then the procedure will not run
'If count of unsent e-mails is greater than zero, msgbox will prompt
'to send mail.
     If intCount = 0 Then
        MsgBox ("You have " & intCount & " emails to send.") _
        , vbInformation, "Posted PRF"
        Exit Sub
    Else
 
rst.MoveFirst
Do While rst.EOF = False
 
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    strEmailAddress = rst![EmployeeEmail]
    aEmail.To = strEmailAddress
        If rst![EmployeeEmail] = strEmailAddress Then
         aEmail.Display
         signature = aEmail.Body
         aEmail.Subject = "Posted payment Request"
         aEmail.Body = "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & _
         vbNewLine & signature
         End If
         If rst.EOF Then Exit Do
        'Loop
     aEmail.Send
    rst.MoveNext
Loop
    End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

[jforbes]

It's dangerous to rewrite code to this extent for a post here on Bytes because people will then expect you to fix it for them forever, like there is some kind of transfer of ownership of the code just by providing help. But I hope that doesn't happen here.

The following code is an example of how it could be structured so that it executes in a more predictable manner. I've put in a some comments to explain why there is a change or what the section is supposed to accomplish. Have a look and see if the changes make sense to you.

One last disclaimer, I didn't attempt to run the code, so there may be bugs or typos.

Public Sub SendMail1()
 
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSubject As String
    Dim strEmailAddress As String
    Dim strEMailMsg As String
    Dim intCount As Integer
    Dim aOutlook As Object
    Dim aEmail As Object
    Dim sSQL As String
    Dim bFirstTime As Boolean
 
    'Count of unsent e-mails
    intCount = DCount("[ID]", "[PRF]", "[Notified]=0")
 
    If intCount = 0 Then
        'If count of unsent e-mails is zero then the procedure will not run
        MsgBox ("You have " & intCount & " emails to send."), vbInformation, "Posted PRF"
        Exit Sub
    Else
        'If count of unsent e-mails is greater than zero, msgbox will prompt to send mail.
        If vbYes = MsgBox("You have " & intCount & " emails to send, continue?", vbQuestion, "Posted PRF") Then
 
            ' Setup email loop
            bFirstTime = True ' Don't attempt to send an email before it's ready.
            Set aOutlook = CreateObject("Outlook.Application") ' Only need to do this once
            sSQL = "SELECT * FROM Email ORDER BY EmployeeEmail, [Vendor Name]"
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset(sSQL)
 
            ' Loop through Invoices
            If Not rst.EOF Then
                Do While Not rst.EOF
                    If strEmailAddress <> rst![EmployeeEmail] Then
 
                        ' EmployeeEmail has changed,
                        ' So send off the current Email (if there is one)
                        ' and create a New one.                        
                        If Not bFirstTime Then
                            ' Send off previously created Email
                            aEmail.Body = strEMailMsg
                            aEmail.Send
                        Else
                            bFirstTime = False
                        End If
 
                        '  Create new Email
                        strEmailAddress = rst![EmployeeEmail]
                        Set aEmail = aOutlook.CreateItem(0)
                        aEmail.To = strEmailAddress
                        aEmail.Subject = "Posted payment Request"
                        aEmail.Display
                    End If
 
                    ' Add Invoice to current Email
                    strEMailMsg = strEMailMsg & "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & vbNewLine
                    rst.MoveNext
                Loop
                If Not bFirstTime Then
                    ' Send Last email, since this hasn't been done yet.
                    aEmail.Body = strEMailMsg
                    aEmail.Send
                End If
            End If
 
            ' Cleanup.  Don't worry about the DB Reference
            rst.Close
            Set rst = Nothing
 
            'Run update to update the sent mail check box
            sSQL = "UPDATE PRF SET PRF.Notified = -1 WHERE (((PRF.Notified)=0))"
            dbs.Execute sSQL
            MsgBox "All new emails have been sent for posted PRF", vbInformation, "Thank You"
 
        End If
    End If
End Sub