Tried to run but came up with no loop

[Ruegen]

Trying to loop through some code so that it sends one email after the next but it stops and I can't figure out why...?

Dim rs As DAO.Recordset
Dim msgbody As String
Dim emsubject As String
Dim AlternativeName As String
Dim TourOrganiserORPeter As String
Dim cEmail As String
Dim recCount As String
Dim sEmail As String
Dim messagebodyHTML As String
Dim MyPDFPath As String
Dim MyPDFFilename As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim mresponse As Integer


Set rs = Me.RecordsetClone


'makes a temp folder
 If Dir("C:\PDF Files", vbDirectory) = "" Then
        MkDir ("C:\PDF Files")
    Else
         MsgBox "C:\PDF Files\ directory already exists, so it won't create another to store your temporary PDF files"
    End If


'first check if dates are in and form has records
If IsNull(Me.txtAfterDate) Or IsNull(Me.txtBeforeDate) Then
MsgBox "Please fill the from and until date fields with dates"
Else


'task if form doesn't have records
If rs.RecordCount <= 0 Then
MsgBox "No records to email"
rs.Close
Set rs = Nothing
Exit Sub
Else


recCount = rs.RecordCount


'as if you want to email
mresponse = MsgBox("Are you sure you want to email " & recCount & " school with their bookings?", vbYesNo, "Continue")
If mresponse = vbYes Then






rs.MoveFirst
Do Until rs.EOF








      
                                
'Message body for email
msgbody = ""




messagebodyHTML = ""


emsubject = "Reminder of your performance on " & rs!BookingDate


MyPDFPath = "C:\PDF Files\"
MyPDFFilename = "Appraisal.pdf"






If IsNothing(rs!SchoolEmail) Or rs!ConfirmationSent4th = -1 Then
MsgBox "this one skipped " & rs!SchoolName
rs.MoveNext
Else


sEmail = rs!SchoolEmail


On Error GoTo ErrorHandler 'This gives you a message if you cancel the whole process


DoCmd.OpenReport "rptAppraisalsEmailALL", acViewPreview, , "TeacherID=" & rs!TeacherID
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPDFPath & MyPDFFilename, False
DoCmd.Close acReport, "rptAppraisalsEmailALL"




                        'open Outlook, attach report email off
                        Set appOutLook = CreateObject("Outlook.Application")
                        Set MailOutLook = appOutLook.CreateItem(0)


                        With MailOutLook
                        .BodyFormat = 2
                        .To = sEmail
                        ''.cc = ""
                        ''.bcc = ""
                        .subject = emsubject
                        .HTMLBody = messagebodyHTML
                        .Attachments.add ("C:\PDF Files\Appraisal.pdf")
                        .DeleteAfterSubmit = False 'This would let Outlook send the note without storing it in your sent bin
                        .ReadReceiptRequested = True
                        .Send
                        End With


If Me.ConfirmationSent4th = False Then
Me.ConfirmationSent4th = True
End If


rs.MoveNext
End If
Loop




Else
rs.Close
Set rs = Nothing
Exit Sub
MsgBox "You have cancelled emailing"
End If ' end if for if you want to email question




End If 'end if for recordscount check
End If 'end if for blank date fields on form


ErrorHandler:
            Select Case Err
             Case 2501
             If CurrentProject.AllReports("rptAppraisalsEmailALL").IsLoaded Then
             DoCmd.Close acReport, "rptAppraisalsEmailALL"
             End If
             MsgBox "You have cancelled sending emails"
             End Select
rs.Close
Set rs = Nothing
End Sub

Can anyone spot why it won't loop from one to the next??

[ItsMe]

Is this end if for the msgbox?

rs.MoveNext
End If
Loop

Maybe loop before the end if...

[Ruegen]

Is this end if for the msgbox?

rs.MoveNext
End If
Loop

Maybe loop before the end if...

Yes, it baisically checks if it has been sent a confirmation or​ has a blank email and then displays a message box then moves to the next record - else it emails the school.

[Ruegen]

Plus if I put it before the end if I get this error when I compile... or run.

[Ruegen]

I tried putting another loop before the else when doing that confirmation/blank check but I get the same error there then.

I get the feeling the problem is here

If IsNothing(rs!SchoolEmail) Or rs!ConfirmationSent4th = -1 Then
MsgBox "this one skipped " & rs!SchoolName
rs.MoveNext


Else


sEmail = rs!SchoolEmail


On Error GoTo ErrorHandler 'This gives you a message if you cancel the whole process


DoCmd.OpenReport "rptAppraisalsEmailALL", acViewPreview, , "TeacherID=" & rs!TeacherID
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPDFPath & MyPDFFilename, False
DoCmd.Close acReport, "rptAppraisalsEmailALL"




                        'open Outlook, attach report email off
                        Set appOutLook = CreateObject("Outlook.Application")
                        Set MailOutLook = appOutLook.CreateItem(0)


                        With MailOutLook
                        .BodyFormat = 2
                        .To = sEmail
                        ''.cc = ""
                        ''.bcc = ""
                        .subject = emsubject
                        .HTMLBody = messagebodyHTML
                        .Attachments.add ("C:\PDF Files\Appraisal.pdf")
                        .DeleteAfterSubmit = False 'This would let Outlook send the note without storing it in your sent bin
                        .ReadReceiptRequested = True
                        .Send
                        End With


If Me.ConfirmationSent4th = False Then
Me.ConfirmationSent4th = True
End If


rs.MoveNext
End If
Loop

I am asking for it to movenext twice - I think the move next should be once and only after the end if - that way if it is confirmed or blank it will skip the else, go to the movenext before the loop and ignore the first...?

[Ruegen]

I think that fixed it...

End if
rs.movenext
loop

and took out the rs.movenext above...

[ItsMe]

The following could be refactored.

'first check if dates are in and form has records
If IsNull(Me.txtAfterDate) Or IsNull(Me.txtBeforeDate) Then
MsgBox "Please fill the from and until date fields with dates"
Else


'task if form doesn't have records
If rs.RecordCount <= 0 Then
MsgBox "No records to email"
rs.Close
Set rs = Nothing
Exit Sub
Else

Instead of using Else, I would just end the code block

'first check if dates are in and form has records
If IsNull(Me.txtAfterDate) Or IsNull(Me.txtBeforeDate) Then
MsgBox "Please fill the from and until date fields with dates"
Exit sub
End if
'The above could be place before the recordset is created


'task if form doesn't have records
If rs.RecordCount <= 0 Then
MsgBox "No records to email"
rs.Close
Set rs = Nothing
Exit Sub
End if 'Just close it here

With that, you can keep better track of the If statements. Also, sometimes I place a little comment after end if to keep track

If rs.RecordCount <= 0 Then
expression
End If 'rs.RecordCount

[Ruegen]

The following could be refactored.

'first check if dates are in and form has records
If IsNull(Me.txtAfterDate) Or IsNull(Me.txtBeforeDate) Then
MsgBox "Please fill the from and until date fields with dates"
Else


'task if form doesn't have records
If rs.RecordCount <= 0 Then
MsgBox "No records to email"
rs.Close
Set rs = Nothing
Exit Sub
Else

Instead of using Else, I would just end the code block

'first check if dates are in and form has records
If IsNull(Me.txtAfterDate) Or IsNull(Me.txtBeforeDate) Then
MsgBox "Please fill the from and until date fields with dates"
Exit sub
End if
'The above could be place before the recordset is created


'task if form doesn't have records
If rs.RecordCount <= 0 Then
MsgBox "No records to email"
rs.Close
Set rs = Nothing
Exit Sub
End if 'Just close it here

With that, you can keep better track of the If statements. Also, sometimes I place a little comment after end if to keep track

If rs.RecordCount <= 0 Then
expression
End If 'rs.RecordCount

Yeah I might have to take time out of my current tasks and rewrite to what you have there.

At the time I was rushed just to get it working - so I just pieced it together.

If I was to do it again I would use your methods above.

Thanks for your help