在Excel 2016中运行VBA时出现OLE错误？
我正在尝试使用Excel作为数据库，并且正在关注本网站的教程。
问题是，每当我尝试在下面的文件中更新下降，我得到这个错误：“微软正在等待另一个应用程序来完成一个OEL行动”。
我在这里错过了什么或者做错了什么，我该如何解决这个问题？
我正在使用Excel 2016家庭和学生，这是最新的。 我也打开工作簿时启用macros。
在Excel 2007中打开时，同样的文件运行良好。我还注意到，Microsoft ActiveX Data Objects 6.0库在示例中引用了“msado60.dll”，而在Excel 2016中则是“msado60.tlb”文件使用）。
链接到Excel文件
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连接。 你似乎没有在任何地方closures它。
您正试图重新打开已经打开的连接。 OLE服务器错误告诉你，服务器（Excel）忙，因为已经连接了另一个ADO连接。 所有你需要做的就是确保你只打开连接一次 ，然后closures它，当你完成它的工作。
我有类似的问题。 这对我工作：
1.在工具菜单上，单击选项。
2.单击常规选项卡。
3.更改忽略使用dynamic数据交换（DDE）的其他应用程序checkbox，然后单击确定。
我只会build议在使用教程时更改此设置。 虽然它为我解决了这个问题，但也导致Excel在其他一些情况下出现exception。
如果您认为该问题与您的特定版本的ADO绑定，则还可以尝试使用对旧版本（如Microsoft ActiveX Data Objects 2.8库）的引用。
我只是testing你的代码（Excel 2013安装），一切都很好。 没有发生错误或类似的东西。 我也检查了对Microsoft ActiveX Data Objects Library的引用，这也是我的“.tlb”。 所以我认为这不是问题。
但有一个问题，我认为可能是你的错误的原因：
当你的代码行rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic被调用时，macros代码可能会继续运行，并调用下一行，而SQL查询还没有完成。 因此，如果查询仍在运行，则在下一行中调用rs.RecordCount可能会导致错误。
由于我无法重现你的错误，我不能做进一步的testing来解决你的问题。 所以希望我的想法可以帮助你或其他人解决你的问题。