SendObject Loop does not loop through all records!!

[nspader]

I am having trouble with my loop code. The code works very well. However, it only loops through 3 records and then completes without errors. I will post code below. Any help with this would be greatly appreciated.

I am using Windows 2000 with Access 2000, sending email through Outlook 2000.

 
Private Sub Form_Load()
On Error GoTo Err_Form_Load
 
    Dim rst As DAO.Recordset
    Dim bkMark As String
    Dim stDocName As String
    Dim strSendTo As String
    Dim strSubject As String
    Dim strMessageText As String
 
    Set rst = Me.Recordset
 
    bkMark = rst.Bookmark
    Me.Bookmark = bkMark
 
    rst.MoveFirst
 
 
    Do Until rst.EOF
 
        stDocName = "Request for Updated PO Info EMAIL"
        strSendTo = Me.Suppliers_EmailAddress
        strSubject = "Wesco Distribution Shipping Update Report"
        strMessageText = "To:  " & Me.SupplierName & vbCrLf _
            & "" & vbCrLf _
            & "Attached is a Shipping Update Report for certain PO numbers." & vbCrLf _
            & "" & vbCrLf _
            & "Please review the attached report and reply back to this email with the requested information." & vbCrLf _
            & "" & vbCrLf _
            & "Thank you," & vbCrLf _
            & "" & vbCrLf _
            & "Wesco Distribution Expediting Department "
 
        DoCmd.SendObject acSendReport, stDocName, acFormatRTF, strSendTo, , , strSubject, strMessageText
 
    rst.MoveNext
 
    Loop
 
    rst.Close
 
    Set rst = Nothing
 
    DoCmd.Close acForm, "Email", acSaveYes
 
Exit_Form_Click:
    Exit Sub
 
Err_Form_Load:
    MsgBox Err.Description
    Resume Exit_Form_Click
 
End Sub
 
 

Please help me figure this out. I am completely boggled by this.

Nick

[nspader]

Thank you for you help.

I will post my code below as a finished product for this Sub.

 
Private Sub Form_Load()
On Error GoTo Err_Form_Load
 
    Dim rst As DAO.Recordset
    Dim bkMark As String
    Dim stDocName As String
    Dim strSendTo As String
    Dim strSubject As String
    Dim strMessageText As String
 
    Set rst = Me.RecordsetClone
 
    If rst.EOF Then
 
        MsgBox "There are no Supplier Reports to Email in this Branch", vbExclamation, "No e-mail addresses"
 
        rst.Close
 
        Set rst = Nothing
 
        DoCmd.Close acForm, "Email", acSaveYes
 
        Exit Sub
 
    End If
 
    Do While rst.EOF = False
        bkMark = rst.Bookmark
        Me.Bookmark = bkMark
 
        stDocName = "Request for Updated PO Info EMAIL"
        strSendTo = rst![EmailAddress]
        strSubject = "Wesco Distribution Shipping Update Report"
        strMessageText = "To:  " & rst![SupplierName] & vbCrLf _
            & "" & vbCrLf _
            & "C/O:  " & rst![ContactName] & vbCrLf _
            & "" & vbCrLf _
            & "Attached is a Shipping Update Report for certain PO numbers." & vbCrLf _
            & "" & vbCrLf _
            & "Please review the attached report and reply back to this email with the requested information." & vbCrLf _
            & "" & vbCrLf _
            & "Thank you," & vbCrLf _
            & "" & vbCrLf _
            & "Wesco Distribution Purchasing Department "
 
        DoCmd.SendObject acSendReport, stDocName, acFormatRTF, strSendTo, , , strSubject, strMessageText
 
    rst.MoveNext
 
    Loop
 
    MsgBox "All emails have been sent to Suppliers", 0, "Email Complete"
 
    rst.Close
 
    Set rst = Nothing
 
    DoCmd.Close acForm, "Email", acSaveYes
 
Exit_Form_Click:
    Exit Sub
 
Err_Form_Load:
    MsgBox Err.Description
    Resume Exit_Form_Click
 
End Sub
 
 
 

Thank you again for all of your help. The forum is fantastic!!!