Edit Word document embedded in a workbook and save as copy

Question

I have made a Word template and inserted it to Excel as an object. I am opening it with the code and inputting data to bookmarks and main part. However after code is done doing processes my embedded template has all the data inside. So it is not a template anymore but a file I have created with the code.

Embedded Word template should be opened as a copy, as I do not want to make any changes to original embedded template or null it with the code all the time (or is it the only way it possible to do?). Is it anyhow possible with the code to open embedded Word document as a copy, make changes to it and save as a Word document? I can't find anything useful in the internet.

Sub opentemplateWord()
Dim sh As Shape
Dim objWord As Object ''Word.Document
Dim objOLE As OLEObject
Dim wSystem As Worksheet
Dim cell As Range


    Set wSystem = Worksheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("Object 2")
''Activate the contents of the object
sh.OLEFormat.Activate
''The OLE Object contained
Set objOLE = sh.OLEFormat.Object
''This is the bit that took time
Set objWord = objOLE.Object


'>------- This Part Inputs Bookmarks

objWord.Bookmarks.Item("ProjectName1").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D15").Value
objWord.Bookmarks.Item("ProjectName2").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D16").Value


'>------- This Part Inputs Text


  'ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '<--- This is for closing footer and header?


    With objWord '<--| reference 'Selection' object


For Each cell In ThisWorkbook.Worksheets("Offer Letter").Range("C1", ThisWorkbook.Worksheets("Offer Letter").Range("C" & Rows.Count).End(xlUp))
     Select Case LCase(cell.Value)
    Case "title"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 1")
                .TypeText Text:=cell.Offset(0, -1).Text
    Case "main"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 2")
                .TypeText Text:=cell.Offset(0, -1).Text


    Case "sub"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 3")
                .TypeText Text:=cell.Offset(0, -1).Text


    Case "sub-sub"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 4")
                .TypeText Text:=cell.Offset(0, -1).Text



    End Select
   Next cell
    End With


objWord.Application.Visible = False

''Easy enough
    objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & ", " & Sheets("Other Data").Range("AN7").Value & "_" & Sheets("Other Data").Range("AN8").Value & "_" & Sheets("Other Data").Range("AX2").Value & ".docx"


End Sub

Answer 1

I am doing the same thing and used this post for reference.

I got rid of objUndo object and CustomRecord methods.

Instead, I used the Duplicate method on the OLEobject to protect the original emmbedded doc from being edited. Seemed easier this way. The previous duplicates get removed at beginning so they don't pile up to infinity.

Sub opentemplateWord_v2()
    
    Dim wSheet As Worksheet
    Dim sh As Shape
    Dim objOLE As OLEObject     '<-- og emmbeded doc
    Dim objOLE2 As OLEObject    '<-- duplicate doc
    Dim objWord As Object


    Set wSheet = Worksheets("TemplateSheet")    '<-- worksheet embedded doc is on
    
    
    '--remove all duplicates from previous runs
    '
    '   *the original embedded doc is named 'Object 1'
    '   (seen by clicking on doc --> the 'Name Box' is at the top left)
    '
    For Each sh In wSheet.Shapes
        If sh.Name <> "Object 1" Then sh.Delete
    Next
    
    
    Set sh = wSheet.Shapes("Object 1")     '<-- set the shape to the embedded doc Object
    
    Set objOLE = sh.OLEFormat.Object        '<-- get the embedded object in shape
    Set objOLE2 = objOLE.Duplicate          '<-- create duplicate of embedded object
    
    objOLE2.Verb xlOpen                     '<-- open duplicate doc in the Word application
    Set objWord = objOLE2.Object            '<-- The Word document
    
    
    '~~~~~~~ do the stuff here ~~~~~~~~~~~~~~~~~~~~~~~~~
    '
    '   for mine, I am going to find/replace keyfeilds on the document
    '   (this example is replacing "Planet" with "earth"
    '
    With objWord.Content.Find
        .text = "Planet"
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=1 'wdReplaceOne
        If .Found = True Then .Parent.text = "earth"
    End With


    '-- No Save Action
    '   I amsume the user will want view/edit the output after execution,
    '   and save it in a specific place
    '

    

End Sub

Answer 2

This is an interesting task which I haven't looked at in a few years... The trick is to open the document in the Word application interface, instead of in-place in Excel.

I've adapted the code in the question. In order to make it easier to follow (shorter) I've removed the editing in the Word document except for writing to a couple of bookmarks. That can, of course, be put back in.

1. I very much recommend using VBA to assign a name to the Shape. Office applications feel free to change a generic name they assign, so relying on "Object 2" could, sometime down the line, lead to problems.

2. Do NOT use the Activate method in this scenario (commented out). If the object is already activated in-place the document cannot be opened in the Word.Application.

3. Use the OLEFormat.Object.Verb method with the parameter xlOpen to open the document in Word.

4. Once it's open, the OLE object can be set to a Word document object.

5. From your comments: 'ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '<--- This is for closing footer and header? No. Better to work with the corresponding Range objects. There are lots of examples "out there" for that. Ask a new question if you run into problems using them.

6. A Word document opened in the Word application can be saved as a file (a document opened in-place cannot). The question about not saving edits, however... there are two basic approaches:

   • SaveAs before editing, open that document, edit and save. The original should then be untouched
   • Do the editing in the object, save then undo the changes. This approach is shown in the code sample

7. Word's object model is able to group any number of actions into a single "undo record".

   Set objUndo = objWord.Application.UndoRecord
   objUndo.StartCustomRecord "Edit In Word"
   

After the editing has been done, to get back to an "empty" (unchanged) document:

    objUndo.EndCustomRecord
    Set objUndo = Nothing
    objWord.Undo

Finally, to close the document quit the Word application without saving changes.

Sub opentemplateWord()
    Dim sh As Shape
    Dim objWord As Object, objNewDoc As Object ''Word.Document
    Dim objOLE As OLEObject
    Dim wSystem As Worksheet
    Dim cell As Range       

    Set wSystem = Worksheets("Templates")
    ''The shape holding the object from 'Create from file'
    ''Object 2 is the name of the shape
    Set sh = wSystem.Shapes("WordFile")
    ''The OLE Object contained
    Set objOLE = sh.OLEFormat.Object
    'Instead of activating in-place, open in Word
    objOLE.Verb xlOpen
    Set objWord = objOLE.Object 'The Word document    

    Dim objUndo As Object 'Word.UndoRecord        
   'Be able to undo all editing performed by the macro in one step
    Set objUndo = objWord.Application.UndoRecord
    objUndo.StartCustomRecord "Edit In Word"

    With objWord
        .Bookmarks.Item("ProjectName1").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D15").Value
        .Bookmarks.Item("ProjectName2").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D16").Value

        objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & _
           ", " & Sheets("Other Data").Range("AN7").Value & "_" & _
           Sheets("Other Data").Range("AN8").Value & "_" & _
           Sheets("Other Data").Range("AX2").Value & ".docx"

        objUndo.EndCustomRecord
        Set objUndo = Nothing
        objWord.Undo
        .Application.Quit False

    End With
    Set objWord = Nothing
End Sub