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

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

这只有在自动执行冗长的任务时才会发生。

我怎样才能以适当的方式处理这个问题？

两个最近的例子（我重新调整代码是不太重要的）：

• 使用Access.Application从Excel创build一个accdb-Database，并通过在大量数据上运行相当复杂的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模板和dynamicSQL查询来创build邮件合并，这些查询返回接收者

   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 

笔记：

• 当以较小的比例运行时（例如，查询较less的logging或使用不那么复杂的模板时），两个代码都可以顺利运行。
• 在这两种情况下，当我通过所有重新出现的提示时，代码将最终完成所需的结果。 因此，我想我没有遇到一个错误（也不会触发error handling程序），而是像超时。

正如其他来源所build议的，我把我的代码包装到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