title: Edit Word document embedded in a workbook and save as copy
body: <p>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.</p>
  
  <p>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. </p>
  
  <pre><code>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
  
  
  '&gt;------- 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
  
  
  '&gt;------- This Part Inputs Text
  
  
    'ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '&lt;--- This is for closing footer and header?
  
  
      With objWord '&lt;--| reference 'Selection' object
  
  
  For Each cell In ThisWorkbook.Worksheets("Offer Letter").Range("C1", ThisWorkbook.Worksheets("Offer Letter").Range("C" &amp; 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 &amp; "\" &amp; Sheets("Other Data").Range("AN2").Value &amp; ", " &amp; Sheets("Other Data").Range("AN7").Value &amp; "_" &amp; Sheets("Other Data").Range("AN8").Value &amp; "_" &amp; Sheets("Other Data").Range("AX2").Value &amp; ".docx"
  
  
  End Sub
  </code></pre>