Home » excel » excel – Write text and bookmarks to a Word template embedded in a workbook

excel – Write text and bookmarks to a Word template embedded in a workbook

Posted by: admin May 14, 2020 Leave a comment

Questions:

(This question is a follow-up on how to work with a document embedded in an Excel workbook in the Word application interface (instead of in-place). The reason this is necessary is to be able to save the result as an independent document.)

This code is doing what is needed to do. Opening embedded Word template, filling it in and saving it as new copy. The only part that is not working is .Application.Quit False. Getting Word error: “Microsoft Word has stopped working”. What can be the possible reason of this failure?

Sub opentemplateWord()
Dim sh As Shape
Dim objOLE As OLEObject
Dim objWord As Object 'Word.Document
Dim objRng As Object 'Word.Range
Dim objUndo As Object 'Word.UndoRecord
Dim cell As Excel.Range
Dim xlRng As Excel.Range
Dim xlSht As Worksheet


Set xlSht = Sheets("Main")

With xlSht
  Set xlRng = .Range("E1", .Range("E" & Rows.Count).End(xlUp))
End With

''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = Worksheets("Templates").Shapes("WordFile")
''Activate the contents of the object
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object

With objWord
  Set objRng = .Range.Characters.Last
  Set objUndo = .Application.UndoRecord
  objUndo.StartCustomRecord ("Doc Data")
  Set xlSht = Sheets("Main")
  .Bookmarks("ProjectName1").Range.Text = xlSht.Range("B10").Value
  .Bookmarks("ProjectName2").Range.Text = xlSht.Range("B11").Value
  .Bookmarks("ProjectName3").Range.Text = xlSht.Range("B12").Value
  .Bookmarks("ProjectName4").Range.Text = xlSht.Range("B13").Value
  .Bookmarks("ProjectName5").Range.Text = xlSht.Range("B14").Value

  For Each cell In xlRng
    objRng.InsertAfter vbCr & cell.Offset(0, -1).Text
     Select Case LCase(cell.Value)
        Case "title"
          objRng.Paragraphs.Last.Style = .Styles("Heading 1")
        Case "main"
          objRng.Paragraphs.Last.Style = .Styles("Heading 2")
        Case "sub"
          objRng.Paragraphs.Last.Style = .Styles("Heading 3")
        Case "sub-sub"
          objRng.Paragraphs.Last.Style = .Styles("Heading 4")
        Case "par"
          objRng.Paragraphs.Last.Style = .Styles("Normal")
    End Select
  Next cell
  Set xlSht = Sheets("Main")
  .SaveAs2 ActiveWorkbook.Path & "\" & _
    xlSht.Range("B2").Value & ", " & _
    xlSht.Range("B3").Value & "_" & _
    xlSht.Range("B4").Value & "_" & _
    xlSht.Range("B5").Value & ".docx"
  objUndo.EndCustomRecord
  .Undo
  .Application.Quit False '<---- Please close Word application
End With
Set objWord = Nothing '<---- Please free up objWord
End Sub
How to&Answers:

When automating another Office application memory can get “tied up” for various reasons. One important factor is managing objects the code has been using. At some point, these need to be “released” in order to free up memory. If they aren’t properly disposed of, they can keep the application open (even if it’s not visible) and cause problems.

One possible problem could be the multiple instantiation of xlSheet. Since it’s always being assigned the same worksheet, this only needs to be done once. If you want to re-use an object (for a different object) and the code has problems, first set the object to Nothing before assigning a different object to it. (This is usually not necessary but sometimes it helps.)

The code in the question is running in Excel and uses a number of Word objects. These Word objects can become a problem (the Excel objects will “go out of scope” when the procedure ends). Therefore, it’s good coding practice to set the object so Nothing as soon as they are no longer needed.

Sample code from the question to illustrate:

  With objWord  'a Word document
     objUndo.EndCustomRecord
    .Undo
    Set objUndo = Nothing '<---- Release Word objects in Excel code
    Set objRng = Nothing
    .Application.Quit False '<---- Please close Word application
  End With
  Set objWord = Nothing '<---- Please free up objWord
End Sub