Runtime error 3021- Either BOF or EOF is reached , unable to resolve this

[ruvi]

I am getting runtime error 3021 - Either EOF or BOF is true or the current record has been deleted.....
I have 2 combo boxes in a form- One for the client and the other for the project.
When the form loads, the client combo box gets populated with all the clients.
When a particular client is clicked, the project combo box gets populated with all the projects corresponding to that client.
So far, so good. Now when I click a project in the project combo box, I get this runtime error.
Been stuck here for 2 days without a solution. Please help.

This is the code I have

Private Sub Form_Load()
 
    Call SetupADO
    Call SetupClients
 
End sub
 
 
Private Sub SetupADO()
 
    Dim adoParm As ADODB.Parameter
'Create connection object and connect to database
    Set acnChecklist = New ADODB.Connection
 
    With acnChecklist
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\My Documents\Specifications\Checklist1.mdb;Persist Security Info=False"
        .Open
        .CursorLocation = adUseClient
    End With
 
 
' Setup the clients command and record set
    Set acmClients = New ADODB.Command
    With acmClients
        .ActiveConnection = acnChecklist
        .CommandType = adCmdText
        .CommandText = "SELECT ClientID, ClientName from tblClients"
    End With
 
    Set arsClients = Nothing
 
' Setup the projects command and record set
    Set acmProjects = New ADODB.Command
    With acmProjects
        .ActiveConnection = acnChecklist
        .CommandType = adCmdText
        .CommandText = "SELECT ProjectID, ProjectName FROM tblProject WHERE ClientID= ?"
        Set adoParm = .CreateParameter("ClientID", adNumeric, adParamInput, , 1)
        .Parameters.Append adoParm
    End With
 
End sub
 
Populate the Clients Combo box
Private Sub SetupClients()
   'Execute Query         
    Set arsClients = New ADODB.Recordset
    arsClients.Open acmClients, , adOpenStatic, adLockOptimistic
 
    ' Populate combo-box with query results
    cboClients.Clear
    While Not arsClients.EOF
        cboClients.AddItem arsClients!ClientName
        arsClients.MoveNext
    Wend
    cboClients.Text = ""
    cboProjects.Text = ""
 
End sub
 
' Handle change in client selection
Private Sub cboClients_Click()
    Dim strClientName As String
    Dim iClientID As Integer
 
    ' If nothing selected, then do nothing
    If cboClients.Text = "" Then
        Exit Sub
    End If
 
    strClientName = cboClients.Text
 
    arsClients.Find "ClientName= '" & strClientName & "'", , adSearchForward, adBookmarkFirst
    iClientID = arsClients("ClientID")
 
     Call SetupProjects(iClientID)
 
    End Sub
 
 
'Populate the projects combo box based on the selected client
Private Sub SetupProjects(ByRef iClientID As Integer)
 
    Call acmProjects.Parameters.Delete("ClientID")
    Dim adoParm As ADODB.Parameter
    Set adoParm = acmProjects.CreateParameter("ClientID", adNumeric, adParamInput, , iClientID)
    Call acmProjects.Parameters.Append(adoParm)
 
    If arsProjects Is Nothing Then
        Set arsProjects = New ADODB.Recordset
        arsProjects.Open acmProjects, , adOpenStatic, adLockOptimistic
    Else
       arsProjects.Requery
    End If
 
    cboProjects.Clear
    While Not arsProjects.EOF
        cboProjects.AddItem arsProjects!ProjectName
        arsProjects.MoveNext
    Wend
 
End Sub
 
 
Private Sub cboProjects_Click()
    Dim strProjectName As String
    Dim iProjectID As Long
 
    If cboProjects.Text = "" Then
        Exit Sub
    End If
    strProjectName = cboProjects.Text
    If arsProjects Is Nothing Then
        Set arsProjects = New ADODB.Recordset
        arsProjects.Open acmProjects, , adOpenStatic, adLockOptimistic
    Else
        arsProjects.Requery
    End If
    With arsProjects
    If .BOF And .EOF Then
            .Requery
            .MoveFirst
    End If
    End With
 
    arsProjects.Find "ProjectName='" & strProjectName & "'", adSearchForward, adBookmarkFirst
    iProjectID = arsProjects("ProjectID") ------> Error in this line

End Sub

Hope u guys can bail me out.

[vijaydiwakar]

Dear need not to post entire code here just put the code which have th error
use

if Rs0.eof or rs0.bof then
'msgbox "No mor records found"
else
' put ur code here
end if

where Rs0 is the Recordset
try it
Good Luck

[Killer42]

Have you tried stepping through the cboProjects_Click routine, checking the effects on arsProjects at every point?

Also, I find it odd how you are doing the "If BOF and EOF then ReQuery and MoveFirst" just before the end of this code. Just prior to that, you have either created or requeried arsProjects. So if this condition is true, doesn't that mean the dataset is empty? In which case, another requery doesn't seem as though it will help.

[Killer42]

if Rs0.eof or rs0.bof then
'msgbox "No mor records found"
else
' put ur code here
end if

Wouldn't this prevent your code ever being executed? Presumably we'd be starting at the beginning, so BOF would be true.

[ruvi]

Thanks for ur time guys.

Strangely I get the runtime error only while clicking on the first project in the combobox, and not while clicking the second or third or fourth project or any subsequent projects. Why is this so?

Also, after Recordset.requery, I am able to print all the records(projects) in
the recordset. It means that the recordset is not empty, isn't it? Then why is it that I am getting the error only while clicking on the first project in the combo box. Is it due to the parametrized SQL statement that I am using to access the projects table?
Help please...

[sudheernis]

this is the solution to runtime r.eof or r.bof here r is the recordset

do until r.eof
            if r.eof=true then
                    r.movelast
             end if
      r.movenext
loop

for bof

do until r.bof
         if r.bof = true then
                 r.movefirst
          end if
 r.moveprevious
loop

by sudheer

[ahmedtharwat19]

in code below
when i goto new record and use mouse wheel
i have a runtime error 3021

Public CurrentBookmark As String
Public MouseWheelMoved As Boolean
 
Private Sub Form_Current()
If MouseWheelMoved = True Then
Me.Bookmark = CurrentBookmark
End If
MouseWheelMoved = False
End Sub
 
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
CurrentBookmark = Me.Bookmark
MouseWheelMoved = True
MsgBox "cannot use mouse wheel"
End Sub
 
 

please help?

[ahmedtharwat19]

hey any one can help
i found th 70% of soulotion
but when goto new record and move up it work but when move down not work
why??
please need help??

Public CurrentBookmark As String
Public MouseWheelMoved As Boolean
 
Private Sub Form_Current()
on error resume next
If MouseWheelMoved = True Then
Me.Bookmark = CurrentBookmark
End If
MouseWheelMoved = False
End Sub
 
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
on error resume next
CurrentBookmark = Me.Bookmark
MouseWheelMoved = True
MsgBox "cannot use mouse wheel"
End Sub