如何应对“的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