我正在编写一个函数，它将起始行，完成行，列和字符串值作为输入。然后，该函数使用字符串值查询数据库，以获取与查询匹配的结果列表，如下所示。从那里开始，从开始到结尾的每一行都会添加一个组合框，并使用生成的查询数据进行填充。
当我尝试运行此代码时，它会以两种方式之一失败。这是我的错误：
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
答案 0 :(得分：1)
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
答案 1 :(得分：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.