如何处理“ Microsoft Excel正在等待另一个应用程序完成OLE操作”

Question

当使用excel自动化其他MS-Office应用程序时，我经常会收到仅显示正常提示的提示， Microsoft Excel is waiting for another application to complete an OLE action.

这仅在使冗长的任务自动化时才会发生。

我该如何以适当的方式处理呢？

最近的两个示例（我认为代码不太重要）：

• 使用Excel从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
  

• Word.Application使用现有的相当大的.docm-templates模板和动态SQL查询（从返回收据中）创建Excel中的邮件合并

  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
  

笔记：

• 当以较小的规模运行时（例如，查询较少的记录或使用不太复杂的模板时），两个代码都可以平稳运行。
• 在这两种情况下，当我OK通过所有重新出现的提示时，代码最终都将以所需的结果结束。因此，我想我没有遇到错误（也不会触发错误处理程序），而是发生了超时。

正如其他资料来源所建议的那样，我确实将代码包装到中Application.DisplayAlerts = False。但是，这似乎是一个可怕的想法，因为实际上在某些情况下确实需要提醒我。

Answer 1

我将在注释中添加@Tehscript链接到的代码。

您可以通过使用COM API删除VBA的消息筛选器来解决此问题。当COM认为您正在调用的进程已阻塞时，这将防止COM告诉VBA显示消息框。请注意，如果该进程确实由于某种原因而被阻止，这将阻止您接收到任何有关此的通知。[ 来源 ]

我认为这是我早在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