Excel 2016でVBAを実行するとOLEエラーが発生しますか？

Question

私はデータベースとしてExcelを使用しようとしており、私はthis siteからチュートリアルに従っています。

問題は、以下のファイルで「Update Drop Downs」を実行しようとすると、「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 

Answer 1

、あなたのOpenDB方法は、ADO接続を開いています。 閉じるどこにも表示されません。

すでに開いている接続を再度開こうとしています。 OLEサーバーのエラーは、すでに別のADO接続が接続されているため、サーバー（Excel）がビジー状態であることを示しています。あなたがする必要があるのは、を一度だけ開き、とし、作業を終えたら閉じてください。

Answer 2

私も同様の問題がありました。これは私のために働いた：
1.ツールメニューで、オプションをクリックします。
2. [全般]タブをクリックします。
3. [ダイナミックデータエクスチェンジ（DDE）を使用する他のアプリケーションを無視する]チェックボックスを変更し、[OK]をクリックします。

チュートリアルの作業中にこの設定を変更することをお勧めします。この問題が私のために解決されたが、それはまたExcelが他のいくつかの状況で不思議な振る舞いをする原因となった。

問題が特定のバージョンのADOに関連していると思われる場合は、古いバージョン（Microsoft ActiveX Data Objects 2.8 Libraryなど）への参照を使用することもできます。

Answer 3

私はあなたのコード（Excel 2013がインストールされている）をテストしましたが、すべてうまくいきました。エラーは発生しません。私はまた、Microsoft ActiveXデータオブジェクトライブラリへの参照をチェックし、それも私のための ".tlb"です。だから私はこれが問題ではないと思う。

しかし、私はあなたのエラーの原因かもしれないと思う問題があります：あなたのコード行rs.Open strSQL, cnn, adOpenKeyset, adLockOptimisticは、SQLクエリがいない間、マクロコードは、おそらく次の行を実行し、呼び出し続けることができると呼ばれる

は、まだ完了しました。したがって、次の行にrs.RecordCountを呼び出すと、クエリがまだ実行中の場合にエラーが発生する可能性があります。

私はあなたのエラーを再現できませんでしたので、あなたの問題を解決するためのさらなるテストはできません。だからうまくいけば私のアイデアはあなたや他の誰かがあなたの問題を解決するのに役立つかもしれない