Search code examples
vbaexcelms-wordole

Generating a Microsoft Word Report from Excel—Application Waiting for OLE Action? (VBA)

I'm trying to write a macro that will generate a Microsoft Word 'report' from an Excel file. I want for the macro to navigate to bookmarks in a Word template for the report, and insert at each certain content or a chart from the native Excel file. The macro works when running in piecemeal, but altogether fails to execute, with Excel repeating over and over that "[It] is waiting for another application to complete an OLE action."

To clarify also, the macro first clears a certain 'data dump' region in the workbook (its native file) and repopulates it with new data from a specified file. This file (its location path) and the various 'target row' and 'identifier' variables you see in the code are inputted by the user to a sort of interface (just a worksheet in the native workbook), where each is labeled manually as a (named) range to be easily fed into to be used by the code. The macro then creates the report by going through the different sheets of the workbook, copying certain content, and turning to Word to paste the copied content at template locations indicated by bookmarks.

I'm completely perplexed by the 'OLE error'. Any ideas about this/the code otherwise? Please share. Thanks for your help!

Sub GenerateReport()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim myWorkbook As Excel.Workbook
Set myWorkbook = ThisWorkbook
Dim myWorksheet As Excel.Worksheet
Set myWorksheet = myWorkbook.Sheets("Sheet1")
Dim myWorksheet2 As Excel.Worksheet
Set myWorksheet2 = myWorkbook.Sheets("Sheet2")
Dim myWorksheet3 As Excel.Worksheet
Set myWorksheet3 = myWorkbook.Sheets("Sheet3")

Dim FileName As String
FileName = myWorksheet.Range("FileName")
Dim FilePath As String
FilePath = myWorksheet.Range("FilePath")
Dim TargetSheetName As String
TargetSheetName = myWorksheet.Range("TargetSheetName")
Dim PasteSheetName As String
PasteSheetName = myWorksheet.Range("PasteSheetName")

Dim Identifier As String
Identifier = myWorksheet.Range("Identifier")
Dim Identifier2 As String
Identifier2 = myWorksheet.Range("Identifier2")
Dim TargetRow As String
TargetRow = myWorksheet.Range("TargetRow")
Dim TargetRow2 As String
TargetRow2 = myWorksheet.Range("TargetRow2")
Dim PasteIdentifier As String
PasteIdentifier = myWorksheet.Range("PasteIdentifier")
Dim PasteIdentifier2 As String
PasteIdentifier2 = myWorksheet.Range("PasteIdentifier2")
Dim PasteTargetRow As String
PasteTargetRow = myWorksheet.Range("PasteTargetRow")
Dim PasteTargetRow2 As String
PasteTargetRow2 = myWorksheet.Range("PasteTargetRow2")

Dim Text As String
Text = myWorksheet.Range("Text")
Dim Text2 As String
Text2 = myWorksheet.Range("Text2")
Dim Text3 As String
Text3 = myWorksheet.Range("Text3")

Dim ReportTemplateFilePath As String
ReportTemplateFilePath = myWorksheet.Range("ReportTemplateFilePath")
Dim ReportTemplateFileName As String
ReportTemplateFileName = myWorksheet.Range("ReportTemplateFileName")
Dim SaveToLocation As String
SaveToLocation = myWorksheet.Range("SaveToLocation")

Dim SourceTargetSheet As Excel.Worksheet
Set SourceTargetSheet = myWorkbook.Sheets(PasteSheetName)
Dim TargetWorkbook As Excel.Workbook
Set TargetWorkbook = Workbooks.Open(FilePath)
Dim TargetSheet As Excel.Worksheet
Set TargetSheet = TargetWorkbook.Sheets(TargetSheetName)

'Clear old info
Dim UpperLeftHandCornerOfClear As String
UpperLeftHandCornerOfClear = "A" & PasteTargetRow
Dim LowerRightHandCornerOfClear As String
LowerRightHandCornerOfClear = "XFD" & PasteTargetRow2
SourceTargetSheet.Range(UpperLeftHandCornerOfClear, LowerRightHandCornerOfClear).ClearContents

'Copy new info for pasting
Dim StartingColumnAsRange As Range
Set StartingColumnAsRange = TargetSheet.Cells.Find(Identifier, LookIn:=xlValues, LookAt:=xlPart)
If Not StartingColumnAsRange Is Nothing Then
    Dim StartingColumn As String
    StartingColumn = Split(StartingColumnAsRange.Address, "$")(1)
End If
Dim EndingColumnAsRange As Range
Set EndingColumnAsRange = TargetSheet.Cells.Find(Identifier2, LookIn:=xlValues, LookAt:=xlPart)
If Not EndingColumnAsRange Is Nothing Then
    Dim EndingColumn As String
    EndingColumn = Split(EndingColumnAsRange.Address, "$")(1)
End If
Dim UpperLeftHandCornerOfCopy As String
UpperLeftHandCornerOfCopy = StartingColumn & TargetRow
Dim LowerRightHandCornerOfCopy As String
LowerRightHandCornerOfCopy = EndingColumn & TargetRow2
TargetSheet.Range(UpperLeftHandCornerOfCopy, LowerRightHandCornerOfCopy).Copy
Dim PastePasteTarget As String
PastePasteTarget = "A" & PasteTargetRow
SourceTargetSheet.Range(PastePasteTarget).PasteSpecial Paste:=xlPasteValues

'Create a Microsoft Word object (instance of Word to control)
Dim WordApplication As Word.Application
Set WordApplication = CreateObject("Word.Application")

'Error handle if Microsoft Word is open
On Error Resume Next
    Set WordApplication = GetObject(class:="Word.Application")
    Err.Clear
    If WordApplication Is Nothing Then
        Set WordApplication = CreateObject(class:="Word.Application")
    End If
On Error GoTo 0

'Error handle if report template is specifically already open
On Error Resume Next
Application.DisplayAlerts = False
Documents(ReportTemplateFileName).Close SaveChanges:=wdDoNotSaveChanges
On Error GoTo 0
Application.DisplayAlerts = True

Dim WordDocument As Word.Document
Set WordDocument = WordApplication.Documents.Open(ReportTemplateFilePath)

'Content from 'myWorksheet'
With WordDocument
    .Bookmarks("Bookmark1").Range.Text = myWorksheet.Range("Text1")
    .Bookmarks("Bookmark2").Range.Text = myWorksheet.Range("Text2")
    .Bookmarks("Bookmark3").Range.Text = myWorksheet.Range("Text3")
    .Bookmarks("Bookmark4").Range.Text = myWorksheet.Range("Text4")
End With

'Content from 'myWorksheet2'
With WordDocument
    .Bookmarks("Bookmark5").Range.Text = myWorksheet2.Range("Text5")
    .Bookmarks("Bookmark6").Range.Text = myWorksheet2.Range("Text6")
    .Bookmarks("Bookmark7").Range.Text = myWorksheet2.Range("Text7")
    .Bookmarks("Bookmark8").Range.Text = myWorksheet2.Range("Text8")
    .Bookmarks("Bookmark9").Range.Text = myWorksheet2.Range("Text9")
    .Bookmarks("Bookmark10").Range.Text = myWorksheet3.Range("Text10")
End With

'Chart (alone on worksheet)
WordApplication.Selection.Goto What:=wdGoToBookmark, Name:="Chart1"
ThisWorkbook.Sheets("Chart 1 Worksheet Name").ChartObjects(1).Copy
WordApplication.Selection.Paste
WordApplication.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'Two charts grouped together
WordApplication.Selection.Goto What:=wdGoToBookmark, Name:="Chart2"
ThisWorkbook.Sheets("Chart 2 Worksheet Name").ChartObjects(1).Copy
WordApplication.Selection.Paste
WordApplication.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

With WordDocument
    .SaveAs FileName:=SaveToLocation & " " & Text3, _
            FileFormat:=wdFormatDocumentDefault
    .Close
End With

WordApplication.Quit
Set WordApplication = Nothing
Set WordDocument = Nothing

Application.ScreenUpdating = True
'Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

myWorksheet.Activate
MsgBox "Report successfully generated.", vbInformation, "Completed!"

End Sub
Solution

  • Try modifying your Word application creation script - this is all you need: 

    On Error Resume Next
Set WordApplication = GetObject(class:="Word.Application")
On Error GoTo 0

If WordApplication Is Nothing Then
    Set WordApplication = CreateObject(class:="Word.Application")
End If

    It may be that Word is waiting for some input from you but you're not seeing it because you didn't make the instance visible, so try also adding:

    WordApplication.Visible = True