我正在尝试使用 Excel 作为数据库,并且正在遵循 this site 中的教程。 .
问题是,每当我尝试在下面的文件中“更新下拉菜单”时,我都会收到此错误:“Microsoft 正在等待另一个应用程序完成 OEL 操作”。
我在这里错过了什么或做错了什么,我该如何做正确的事情?
我使用的是最新的 Excel 2016 Home & Student。我还在打开工作簿时启用了宏。
同一个文件在 Excel 2007 中打开时运行完美。我还注意到 Microsoft ActiveX Data Objects 6.0 库在示例中引用了“msado60.dll”,而在 Excel 2016 中它是“msado60.tlb”文件(我用的)。
Private Sub cmdShowData_Click()
'populate data
strSQL = "SELECT * FROM [data$] WHERE "
If cmbProducts.Text <> "" Then
strSQL = strSQL & " [Product]='" & cmbProducts.Text & "'"
End If
If cmbRegion.Text <> "" Then
If cmbProducts.Text <> "" Then
strSQL = strSQL & " AND [Region]='" & cmbRegion.Text & "'"
Else
strSQL = strSQL & " [Region]='" & cmbRegion.Text & "'"
End If
End If
If cmbCustomerType.Text <> "" Then
If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Then
strSQL = strSQL & " AND [Customer Type]='" & cmbCustomerType.Text & "'"
Else
strSQL = strSQL & " [Customer Type]='" & cmbCustomerType.Text & "'"
End If
End If
If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Or cmbCustomerType.Text <> "" Then
'now extract data
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Sheets("View").Visible = True
Sheets("View").Select
Range("dataSet").Select
Range(Selection, Selection.End(xlDown)).ClearContents
'Now putting the data on the sheet
ActiveCell.CopyFromRecordset rs
Else
MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
Exit Sub
End If
'Now getting the totals using Query
If cmbProducts.Text <> "" And cmbRegion.Text <> "" And cmbCustomerType.Text <> "" Then
strSQL = "SELECT Count([data$].[Call ID]) AS [CountOfCall ID], [data$].[Resolved] " & _
" FROM [Data$] WHERE ((([Data$].[Product]) = '" & cmbProducts.Text & "' ) And " & _
" (([Data$].[Region]) = '" & cmbRegion.Text & "' ) And (([Data$].[Customer Type]) = '" & cmbCustomerType.Text & "' )) " & _
" GROUP BY [data$].[Resolved];"
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Range("L6").CopyFromRecordset rs
Else
Range("L6:M7").Clear
MsgBox "There was some issue getting the totals.", vbExclamation + vbOKOnly
Exit Sub
End If
End If
End If
End Sub
Private Sub cmdUpdateDropDowns_Click()
strSQL = "Select Distinct [Product] From [data$] Order by [Product]"
closeRS
OpenDB
cmbProducts.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbProducts.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Products.", vbCritical + vbOKOnly
Exit Sub
End If
'----------------------------
strSQL = "Select Distinct [Region] From [data$] Order by [Region]"
closeRS
OpenDB
cmbRegion.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbRegion.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Region(s).", vbCritical + vbOKOnly
Exit Sub
End If
'----------------------
strSQL = "Select Distinct [Customer Type] From [data$] Order by [Customer Type]"
closeRS
OpenDB
cmbCustomerType.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbCustomerType.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Customer Type(s).", vbCritical + vbOKOnly
Exit Sub
End If
End Sub
最佳答案
根据注释,您的 OpenDB 方法正在打开 ADO 连接。您似乎没有在任何地方关闭它。
您正在尝试重新打开已打开的连接。 OLE 服务器错误告诉您服务器 (Excel) 正忙,因为已经有另一个 ADO 连接连接到它。您需要做的就是确保仅打开连接一次,然后在使用完毕后将其关闭。
关于vba - 在 Excel 2016 中运行 VBA 时出现 OLE 错误?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/39678502/