问题
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 receipentsSet 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.
回答1:
I'll add the code that @Tehscript linked to in the comments.
You can solve this by using the COM API to remove VBA's message filter. This will prevent COM from telling VBA to displaying a message box when it thinks the process you're calling has blocked. Note that if the process really has blocked for some reason this will prevent you from receiving any notification of that. [source]
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
来源:https://stackoverflow.com/questions/44288799/how-to-deal-with-microsoft-excel-is-waiting-for-another-application-to-complete