Dreaded "Waiting for OLE" on macro running mail me

[derekpegg]

I have a macro which places a number of named ranges into a Word template (some conditionally placed) and then runs a mail merge. All works fine up to the mail merge then it seems to hang followed by an Excel message "Excel is waiting for another application to complete an OLE action". I have found that if you ignore this it eventually completes the code.

The macro takes about 7 minutes to run in total and I think it is just a time-out issue.

Does anyone have any ways I may be able to speed up the code and/or stop the OLE warning popping up? I have tried adding, Application.Calculation = xlCalculationManual, Application.EnableEvents = False & Application.DisplayAlerts = False which do not seem to help.

Thanks for any help you are able to give.

My code (truncated: can post full code if needed):

Sub FullSetMerge()

'*****add a reference to the MS Word Object Library (VB-Tools-References)*****


'MESSAGE BOX TO ENSURE ALL OTHER WORD FILES ARE CLOSED
If MsgBox("Please ensure you have no Word documents or templates open. Do you want to continue?", vbYesNo, "Pension Performance Analyser - Create Full Report Set") = vbNo Then Exit Sub
 

Application.ScreenUpdating = False

On Error GoTo ErrHandler

'PLAY START SOUND
ActiveSheet.Shapes("Object 53").Select
            Selection.Verb Verb:=xlPrimary
            
            
'SET ITEMS
Dim FileBerger As String
Dim TemplateBerger As String
Dim appWd As Word.Application


'CREATE A NEW WORD FILE
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
Application.WindowState = xlMinimized


'SET WHERE WORD AND EXCEL FILES ARE LOCATED
FileBerger = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
TemplateBerger = "C:/Templates/Templates/PPR Report Set Auto - MM.dot"


'OPEN WORD TEMPLATE
appWd.Documents.Add Template:=TemplateBerger, NewTemplate:=False


'DECIDE IF TO INCLUDE 'CP'
'Application.Goto Reference:="cpps"
'If Selection.Value = 1 Then


'COPY RANGE 'CP' FROM EXCEL
Application.Goto Reference:="cp"
    Selection.Copy


'FIND BOOKMARK 'CP' IN WORD
appWd.Selection.Goto What:=wdGoToBookmark, Name:="cp"


'PASTE RANGE 'CP'
appWd.Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:= _
wdInLine, DisplayAsIcon:=False


'RESIZE RANGE 'CP'
'appWd.Selection.MoveUp Unit:=wdLine, Count:=2
'appWd.Selection.MoveDown Unit:=wdLine, Count:=1
appWd.Selection.MoveLeft Unit:=wdCharacter, Count:=1
appWd.Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
appWd.Selection.InlineShapes(1).LockAspectRatio = msoFalse
appWd.Selection.InlineShapes(1).ScaleHeight = 84.8
appWd.Selection.InlineShapes(1).ScaleWidth = 76
'End If


'COPY RANGE 'pen' FROM EXCEL
Application.Goto Reference:="pen"
    Selection.Copy


'FIND BOOKMARK 'pen' IN WORD
appWd.Selection.Goto What:=wdGoToBookmark, Name:="pen"


'PASTE RANGE 'pen'
appWd.Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:= _
wdInLine, DisplayAsIcon:=False


'RESIZE RANGE 'pen'
appWd.Selection.MoveLeft Unit:=wdCharacter, Count:=1
appWd.Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
appWd.Selection.InlineShapes(1).LockAspectRatio = msoFalse
appWd.Selection.InlineShapes(1).ScaleHeight = 84.8
appWd.Selection.InlineShapes(1).ScaleWidth = 76


'**** These copy paste routines are repeated several times - different ranges *****


'RUN MAIL MERGE
ActiveDocument.MailMerge.OpenDataSource Name:= _
FileBerger, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"DSN=Excel Files;DBQ=" & FileBerger & ";DriverId=790;MaxBufferSize=8192;PageTimeout=3;ConnectionTimeout=6;CommandTimeout=6;" _
, SQLStatement:="SELECT * FROM `AAAMerge`", SQLStatement1:=""
appWd.Visible = True
appWd.Activate
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = 1
            .LastRecord = 1
        End With
        .Execute Pause:=True
    End With
    
    
'PLAY FINISH SOUND
Sheets("Report Creation").Select
ActiveSheet.Shapes("Object 87").Select
Selection.Verb Verb:=xlPrimary


'CLOSE WORD TEMPLATE KEEPING MERGED FILE OPEN
Documents(2).Close False


'MAKE WORD FILE VISABLE
appWd.WindowState = wdWindowStateMaximize
appWd.Visible = True
Application.WindowState = xlMinimized


'CLEAR ITEMS
Set appWd = Nothing

 Application.ScreenUpdating = True


Exit Sub
ErrHandler:
ActiveSheet.Shapes("Object 15").Select
            Selection.Verb Verb:=xlPrimary
MsgBox "An Error has occured.  Please ensure All MS Word documents and templates are closed.  Try Closing this Pension Performance Analyser and trying to create this report again.", , "Pension Performance Analyser - Create Full Report Set"

Exit Sub

End Sub

 

[MarkAndrews]

Could you not put in some 'wait' functions, so that the macro isn't trying to do everything at once

May add more time to run - but may be more efficient?

 

[derekpegg]

Thanks for the quick reply, Mark.

Do you think a wait function prior to the mail merge would help?

Will give this a go.

 

[MarkAndrews]

Dunno, Working purely on guess here - I had a similar scenario a few weeks back, put in a wait & it seemed to be slightly quicker in effect

M

 

[derekpegg]

I have tried wait line of various times in different places with no joy. Does anyone else have any ideas on this? Thanks.

 

[MarkAndrews]

None, sorry

 

[derekpegg]

Think I have found the answer. My data (Excel) file was on a server and the Word template to merge to was saved locally. When I run it with both files saved locally, it seems to work. No idea why, but I guess I will have to do this in future. Thanks for the suggestions.