Либо BOF, либо EOF истинно и не удается получить свойство OLEObjects

Question

Я пишу функцию, которая принимает в качестве входной строки начальную строку, завершающую строку, столбец и строковое значение. Затем функция запрашивает базу данных со строковым значением, чтобы получить список результатов, соответствующих запросу. Оттуда в каждой строке от начала до конца будет добавлен комбинированный блок и заполнены результирующими данными запроса.

Когда я пытаюсь запустить этот код, он терпит неудачу одним из двух способов. Вот мои ошибки:

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

или

Unable to get OLEObjects property of worksheet class.

Это иногда работает в первой колонке добавленных комбо, чтобы только не на полпути через секунду.

Вызов функции:

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 

Добавить Комбо Функция:

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

Надеюсь, это будет объяснить немного больше, чем мой комментарий:
функция GetDatabaseReference просто возвращает ссылку на вашу базу данных - он изменит ссылку в зависимости от вашей версии Excel.

Важным моментом процедуры TestDatabaseConnection является код после открытия набора записей - он проверяет, все ли в порядке, прежде чем переходить через записи, а затем закрывать набор записей.

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 

Answer 2

Хотя это не может помочь вам в этом случае, здесь это предложение о форматировании вашего 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 Я использовал this утилиты для форматирования SQL из конструктора запросов в этот формат в < 10 сек.