Either BOF or EOF is true and Unable to get OLEObjects property

Question

I am writing a function that takes as input a starting row, finishing row, column, and string value. The function then queries a database with the string value to get a list of results that match the query, below. From there, each row from start to last will have a combo box added and populated with the resultant query data.

When I try and run this code, it fails in one of a couple ways. Here are my errors:

Run-Time error '1021: Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.

or

Unable to get OLEObjects property of worksheet class.

It sometimes works for the first column of added combos, to only fail halfway through the second.

Calling Function:

For i = 0 To numMembers - 1
    For j = 0 To UBound(toolNames) - 1
        Call AddCombos(5 + j * 5, 9 + j * 5, 5 + i * 5, Cells(5 + j * 5, 1).value)
    Next j
Next i

Add Combos Function:

Function AddCombos(ByVal startRow As Integer, ByVal LastRow As Integer, ByVal columnNum As Integer, ByVal Tool As String)
    Dim MyLeft As Double
    Dim MyTop As Double
    Dim MyHeight As Double
    Dim MyWidth As Double
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim curcombo As Object
    Dim StrDBPath As String

    strSQL = "SELECT qryCurrent.txtLevel AS [Current], [qrylstNames-LPMi].strFullName as [Full Name], tblWCMTools.txtWCMTool" & vbNewLine & _
             "FROM (((tblPeopleWCMSkillsByYear" & vbNewLine & _
             "LEFT JOIN tblSkillLevels AS qryCurrent ON tblPeopleWCMSkillsByYear.bytCurrentID = qryCurrent.atnSkillLevelID)" & vbNewLine & _
             "INNER JOIN [qrylstNames-LPMi] ON tblPeopleWCMSkillsByYear.intPeopleID = [qrylstNames-LPMi].atnPeopleRecID)" & vbNewLine & _
             "INNER JOIN tblWCMTools ON tblPeopleWCMSkillsByYear.intWCMSkillID = tblWCMTools.atnWCMToolID)" & vbNewLine & _
             "WHERE (((tblPeopleWCMSkillsByYear.bytYearID)=Year(Date())-2012) AND qryCurrent.txtLevel >='4' AND tblWCMTools.txtWCMTool = '" & Tool & "') ORDER BY strFullName;"

    'database path
    StrDBPath = "C:\Users\T6050R0\Desktop\WCMDB_be.accdb"
    'open database
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;" & _
                             "Data Source=" & StrDBPath & ";" & _
                             "Jet OLEDB:Engine Type=5;" & _
                             "Persist Security Info=False;"
    rst.Open strSQL, cnn, adOpenStatic
    'Iterate through each row
    For i = startRow To LastRow
    'If it's empty, than add a checkbox
        If IsEmpty(Cells(i, columnNum)) Then
            If (Cells(i, columnNum).ColumnWidth <> 20) Then
                Cells(i, columnNum).ColumnWidth = 20
            End If
            'set position of checkbox (compared with cell that will be linked)
            MyLeft = Cells(i, columnNum).Left
            MyTop = Cells(i, columnNum).Top + 2.75
            'set size of checkbox (compared with cell that will be linked)
            MyHeight = Cells(i, columnNum).Height - 5
            MyWidth = Cells(i, columnNum).Width
            'add checkbox
            Set curcombo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=True, _
                            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=MyWidth, Height _
                            :=MyHeight + 1.5)
            'Add a blank option first
            curcombo.Object.AddItem ""
            With Worksheets("Sheet1").OLEObjects(curcombo.Name)
                .LinkedCell = Cells(i, columnNum).Address
                'Move to first record in set
                If (i > startRow) Then
                MsgBox "yay"
                    rst.MoveFirst
                End If
                'add choices to dropdown
                For k = 1 To rst.RecordCount

                    If rst.EOF Then
                        GoTo EndForLoop
                    End If
                    .Object.AddItem rst![Full Name]
                    If Not rst.EOF Then
                        rst.MoveNext
                    Else
                        GoTo EndForLoop
                    End If
                Next k
EndForLoop:
            End With
        End If
    Next i
End Function

Answer 1

Although this might not help you in this case, here is a suggestion about formatting your SQL

Public Sub aa(ByRef a As String, ByVal b As String)

    a = a & vbCrLf & b

End Sub

a = ""
aa a, "    SELECT CUR.txtLevel      AS [Current]  "
aa a, "         , NLPMi.strFullName AS [Full Name]  "
aa a, "         , TOOLS.txtWCMTool "
aa a, "      FROM ( ( ( tblPeopleWCMSKILLSByYear AS SKILLS"
aa a, "                 LEFT JOIN tblSkillLevels AS CUR  "
aa a, "                        ON SKILLS.bytCurrentID = CUR.atnSkillLevelID
aa a, "               ) "
aa a, "              INNER JOIN [qrylstNames-LPMi] AS NLPMi  "
aa a, "                      ON SKILLS.intPeopleID = NLPMi.atnPeopleRecID
aa a, "             )"
aa a, "            INNER JOIN tblWCMTools AS TOOLS "
aa a, "                    ON SKILLS.intWCMSkillID = TOOLS.atnWCMToolID"
aa a, "           ) "
aa a, "     WHERE ( ( (SKILLS.bytYearID) = YEAR(DATE())-2012 )  "
aa a, "           AND CUR.txtLevel   >= '4'  "
aa a, "           AND TOOLS.txtWCMTool = 'Tool'"
aa a, "           )  "
aa a, "  ORDER BY NLPMi.strFullName"
aa a, "  ;"

PS I used this utility to format SQL from the query builder into this format in <10 secs.

Answer 2

Hopefully this will explain a bit more than my comment:
The GetDatabaseReference function just returns a reference to your database - it will change the reference depending on your Excel version.

The important bit of the TestDatabaseConnection procedure is the code after the recordset is opened - it checks everything's ok before stepping through the records and then closing the recordset.

Sub TestDatabaseConnection()

    Dim oDB As Object
    Dim rstMyRecordSet As Object

    'Just a reference so my SQL will work.
    Dim sName As String
    sName = "Darren"

    'This is the first time the reference runs, so it creates the reference.
    Set oDB = GetDatabaseReference(oDB)

    'oDB already holds a value now, so it's not created again - just passed straight back.
    'No need to add this line - just an example.  Usually oDB would be a global variable.
    Set oDB = GetDatabaseReference(oDB)

    Set rstMyRecordSet = CreateObject("ADODB.RecordSet")
    rstMyRecordSet.CursorType = 2
    rstMyRecordSet.Open "SELECT ID FROM tbl_TeamMembers WHERE User_Name = '" & sName & "' AND IsActive = TRUE", oDB

    'This is the important bit - check you've got records.
    If Not rstMyRecordSet Is Nothing Then
        With rstMyRecordSet
            If Not .EOF And Not .BOF Then
                .MoveFirst
                Do While Not .EOF
                    Debug.Print .Fields("User_Name")
                    .MoveNext
                Loop
            End If
        End With
    End If
    rstMyRecordSet.Close
    Set rstMyRecordSet = Nothing

End Sub

'----------------------------------------------------------------------------------
' Procedure : GetDatabaseReference
' Author    : Darren Bartrup-Cook
' Date      : 28/05/2015
' Purpose   : Sets a reference to the Outlook database.
'-----------------------------------------------------------------------------------
Public Function GetDatabaseReference(ExistingConnection As Object) As Object

    Dim cn As Object

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Only set a reference to the database if it doesn't already exist. '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ExistingConnection Is Nothing Then
        Set cn = CreateObject("ADODB.Connection")

        Select Case Val(Application.Version)
            Case 11
                'Access 2003
                cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=S:\Database\Outlook.mdb"
            Case 14
                'Access 2010
                cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=S:\Database\Outlook.mdb;" & _
                    "Persist Security Info=False;"
        End Select


        If Not cn Is Nothing Then
            Set GetDatabaseReference = cn
        End If
    Else

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'oDB already has a reference, so ensure it's maintained. '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Set GetDatabaseReference = ExistingConnection
    End If

End Function