在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錯誤？

回答

相關問題