在Excel 2016中运行VBA时发生OLE错误？

我试图使用Excel作为数据库，并且我正在遵循this site的教程。在Excel 2016中运行VBA时发生OLE错误？

问题是，无论何时我试图在下面的文件中更新下降，我都会收到此错误：“Microsoft正在等待另一个应用程序完成OEL操作”。

我在这里错过或做错了什么，以及我如何得到这个权利？

我使用的是Excel 2016主页&学生是最新的。打开工作簿时也启用宏。

相同的文件在Excel 2007中打开时运行完美。我也注意到Microsoft ActiveX Data Objects 6.0库在示例中引用了“msado60.dll”，而在Excel中则是“msado60.tlb”文件2016（我使用）。

Link to Excel File

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

来源

2016-09-24 Norman

OpenDB是否创建新的数据库连接？ – Comintern

@Comintern是的，它的确如此。 – Norman

在没有VBA的情况下执行此操作可能会更简单https://www.youtube.com/watch?v=P9cUYpXIKsU – Slai

％的意见，你的OpenDB方法打开一个ADO连接。你看起来不是关闭它在任何地方。

您试图重新打开已打开的连接。 OLE服务器错误告诉你服务器（Excel）忙，因为已经连接了另一个ADO连接。所有你需要做的就是确保你只打开连接一次，然后关闭它，当你完成它的工作。

来源

2016-09-24 18:25:55 Comintern

嗯...你是怎么做到的，它会去哪里？ – Norman

@Norman - 除了每个子文件中的第一个文件外，用'OpenDB'删除所有行。然后在每个子结尾添加'cnn.Close'。 – Comintern

这是没有用的:(我尝试删除OpenDB方法并添加你的建议，但它仍然是相同的。 – Norman

我有类似的问题。这对我有用：
1.在工具菜单上，单击选项。
2.单击常规选项卡。
3.更改忽略使用动态数据交换（DDE）的其他应用程序复选框，然后单击确定。

我只会建议在使用教程时更改此设置。虽然它为我解决了这个问题，但也导致Excel在其他一些情况下出现异常行为。

如果您认为该问题与您的特定版本的ADO绑定，则还可以尝试使用对旧版本（如Microsoft ActiveX Data Objects 2.8库）的引用。

来源

2016-09-26 20:59:17

我试过了，但这也不起作用。 – Norman

我刚刚测试了你的代码（Excel 2013安装），一切都很好。没有错误发生或类似的。我也检查了对Microsoft ActiveX Data Objects Library的引用，它也是我的“.tlb”。所以我认为这不是问题。

但有，我觉得可能是你错误的原因一个问题：

当你的代码行rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic被称为宏代码很可能继续运行并调用下一行，而SQL查询不尚未完成。因此，如果查询仍在运行，则在下一行中调用rs.RecordCount可能会导致错误。

由于我无法重现您的错误，我不能做进一步的测试来解决您的问题。所以希望我的想法可以帮助你或其他人解决你的问题。

来源

2016-09-30 14:03:14

在Excel 2016中运行VBA时发生OLE错误？

回答

相关问题