Code Keeps Running

I used to use following code quite successfully but now using it after a long time, I noticed that code simply keeps running between While Not rst.EOF and Wend lines. This lifts the email address from a table where I have users listed and true false in front of their names. So it is designed to address email to selected users. Will appreciate some help in finding out the issue.



Sub EmailLevel1()

Dim db As Database

Dim SQLStmt As String

Dim rst As Recordset

Dim TheRecipients As String



On Error Resume Next



Set db = CurrentDb()

SQLStmt = "SELECT loginid FROM tblDistribution WHERE Level1Schedule=True;"

Set rst = db.OpenRecordset(SQLStmt, dbOpenDynaset)



While Not rst.EOF

If TheRecipients = "" Then

TheRecipients = rst.Fields(0) & ";"

Else

TheRecipients = TheRecipients & rst.Fields(0) & ";"

End If

rst.MoveNext

Wend



If Not Len(TheRecipients) = 0 Then

DoCmd.SendObject acSendReport, "Construction Schedule L1", acFormatSNP, TheRecipients, , , "Construction Schedule - Level 1 (Selected Regions)", "Attached is the Level 1 Construction Schedule for your info." & _

vbCrLf _

& vbCrLf & "Cheers" & vbCrLf _

& vbCrLf & "Issued By: " & vbCrLf _

& vbCrLf & "Construction Team", True

End If

rst.Close

Set rst = Nothing

Set db = Nothing

End Sub

Code Keeps Running