如何應對「的Microsoft Excel正在等待另一個應用程序以完成OLE操作」

Question

當自動化與Excel等MS-Office應用程序，我經常得到確定，只提示說Microsoft Excel is waiting for another application to complete an OLE action.

這隻自動化時發生冗長的任務。

如何以適當的方式處理此問題？最近

兩個例子（我偵察的代碼是不那麼重要）：

• 創建從Excel的ACCDB-數據庫與Access.Application，並通過運行大量數據的相當複雜的SQL查詢填充它。

  Public Function createDB(pathDB As String, pathSQL As String) As String 
  
      Dim dbs As DAO.Database 
      Dim sql As String 
      Dim statement As Variant, file As Variant 
  
      Dim sErr As String, iErr As Integer 
  
      With New Access.Application 
  
       With .DBEngine.CreateDatabase(pathDB, dbLangGeneral) 
  
        For Each file In Split(pathSQL, ";") 
  
         sql = fetchSQL(file) 
         For Each statement In Split(sql, ";" & vbNewLine) 
          If Len(statement) < 5 Then GoTo skpStatement 
          Debug.Print statement 
  
          On Error Resume Next 
          .Execute statement, dbFailOnError 
  
          With Err 
           If .Number <> 0 Then 
            iErr = iErr + 1 
            sErr = sErr & vbCrLf & "Error " & .Number & " | " & Replace(.Description, vbCrLf, vbNullString) 
            .Clear 
           End If 
          End With 
          On Error GoTo 0 
  skpStatement: 
         Next statement 
        Next file 
       End With 
       .Quit acQuitSaveAll 
      End With 
  
      dTime = Now() - starttime 
  
      ' Returnwert 
      If sErr = vbNullString Then sErr = "Keine Fehler" 
      createDB = "Zeit: " & Now & " | Dauer: " & Format(dTime, "hh:mm:ss") & " | Anzahl Fehler: " & iErr & vbCrLf & sErr 
  
      ' Log 
      With ThisWorkbook 
       '... 
       .Saved = True 
       .Save 
      End With 
  
  End Function 
  

• 創建郵件從Excel合併在Word.Application，使用現有的和相當大.docm -templates和動態SQL查詢，返回receipents

  Set rst = GetRecordset(ThisWorkbook.Sheets("Parameter").Range("A1:S100")) 
  
  With New Word.Application 
  
      .Visible = False 
  
      While Not rst.EOF 
       If rst!Verarbeiten And Not IsNull(rst!Verarbeiten) Then 
        Debug.Print rst!Sql 
  
        .Documents.Open rst!inpath & Application.PathSeparator & rst!infile 
        stroutfile = fCheckPath(rst!outpath, True) & Application.PathSeparator & rst!outfile 
  
        .Run "quelle_aendern", rst!DataSource, rst!Sql 
  
        .Run MacroName:="TemplateProject.AutoExec.SeriendruckInDokument" 
  
        Application.DisplayAlerts = False 
  
        .ActiveDocument.ExportAsFixedFormat _ 
         OutputFileName:=stroutfile _ 
         , ExportFormat:=wdExportFormatPDF _ 
         , OpenAfterExport:=False _ 
         , OptimizeFor:=wdExportOptimizeForPrint _ 
         , Range:=wdExportAllDocument _ 
         , From:=1, To:=1 _ 
         , Item:=wdExportDocumentContent _ 
         , IncludeDocProps:=False _ 
         , KeepIRM:=True _ 
         , CreateBookmarks:=wdExportCreateNoBookmarks _ 
         , DocStructureTags:=False _ 
         , BitmapMissingFonts:=True _ 
         , UseISO19005_1:=False 
  
        Application.DisplayAlerts = True 
  
        For Each doc In .Documents 
         With doc 
          .Saved = True 
          .Close SaveChanges:=wdDoNotSaveChanges 
         End With 
        Next doc 
  
       End If 
       rst.MoveNext 
      Wend 
  
      .Quit 
  End With 
  

筆記：

• 當運行as小規模（例如，當查詢較少的記錄或使用不那麼複雜的模板時），這兩種代碼都可以順利運行。
• 在這兩種情況下，當我通過所有重新出現的提示輸入OK時，代碼最終會以期望的結果結束。 因此，我想我沒有遇到錯誤（也不會觸發錯誤處理程序），而是像超時一樣。

正如其他來源所建議的，我把我的代碼包裹到Application.DisplayAlerts = False。然而，這似乎是一個可怕的想法，因爲實際上可能存在我需要提醒的情況。

Answer 1

我將添加@Tehscript鏈接的代碼。
我認爲這是我在2006年使用過的相同問題（它工作）的代碼。

Private Declare Function _ 
    CoRegisterMessageFilter Lib "OLE32.DLL" _ 
    (ByVal lFilterIn As Long, _ 
    ByRef lPreviousFilter) As Long 

Sub KillMessageFilter() 
    '''Original script Rob Bovey 

    '''https://groups.google.com/forum/?hl=en#!msg/microsoft.public.excel.programming/ct8NRT-o7rs/jawi42S8Ci0J 
    '''http://www.appspro.com/ 

    Dim lMsgFilter As Long 

    ''' Remove the message filter before calling Reflections. 
    CoRegisterMessageFilter 0&, lMsgFilter 

    ''' Call your code here.... 

    ''' Restore the message filter after calling Reflections. 
    CoRegisterMessageFilter lMsgFilter, lMsgFilter 

End Sub