How to deal with “Microsoft Excel is waiting for another application to complete an OLE action”

Question

When automating other MS-Office applications with excel, I frequently get ok-only prompts saying that Microsoft Excel is waiting for another application to complete an OLE action.

This only happens when automating lengthy tasks.

How can I deal with this in an appropriate fashion?

Two recent examples (I recon the code is less important):

• creating an accdb-Database from Excel with an Access.Application and populating it by running rather complex SQL-queries on large amount of data.

  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
  

• create mail merges from Excel in a Word.Application, using existing and rather large .docm-templates and dynamic SQL-queries that returns the 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
  

notes:

• When run on a smaller scale (for example, when querying less records or using less complex templates), both codes do run smoothly.
• In both cases, when I OK through all the reappearing prompts, the code will eventually finish with the desired results. Therefore, I guess I'm not encountering an error (also it doesn't trigger the error handlers), but rather something like a timeout.

As suggested on other sources, I do wrap my code into Application.DisplayAlerts = False. This, however, seems like a horrible idea, since there might actually be cases where I do need to be alerted.

Answer 1

I'll add the code that @Tehscript linked to.
I think this is the code I used back in 2006 for the same problem (it worked).

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