Copying all content in OLEObject including header footer with format into new Word.Document/Word.Application

Question

Recently I manage to make an automation in VBA where the external word file in the same folder as the excel file is been opened and add new content from excel then save as the word file different name. Below the code:

Dim wordapp As Word.Application
Dim wordfile As Word.Document
Set wordapp = New Word.Application
Set wordfile = wordapp.Documents.Open(Application.ActiveWorkbook.Path & "<word file name>")

wordapp.Visible = False
<code to manipulate the word.document to insert value and graph from excel>
wordfile.SaveAs Filename:=Application.ActiveWorkbook.Path & "<new word file name>"
wordapp.Quit
Set wordapp = Nothing
Set wordfile = Nothing

The original external word file is behaving like a template with header and footer and some paragraph.

Because the nature of my project, I need to embedded the external word file into the excel thus turning the external word file into OLEObject in excel file. Even though I manage to open the OLEObject and manipulate the word.document to insert value and graph from excel and save as external word file, the closed OLEObject will also retain the insert value and graph making it not good for use as template.

I come up with this code. Basically to open the OLEObject and copy the content, then create a new word file and paste the content in it so that the OLEObject will not retain any changes:

Dim objSampleReport As OLEObject
Dim wordApp As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document

Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordFileEmbed = objSampleReport.Object
Set wordApp = New Word.Application
Set wordFileNew = wordApp.Documents.Add

wordFileEmbed.Content.Copy
wordFileNew.Content.PasteAndFormat

wordFileEmbed.Application.Quit False

<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>

Eventhough I manage to copy the OLEObject and retain the embedded as original intended, the new created word file dont have header footer and the format is wrong.

So I try to record the copypaste behaviour using Word Macro and this is come up:

Selection.WholeStory
Selection.Copy
Windows("Document1").Activate
Selection.PasteAndFormat (wdUseDestinationStylesRecovery)

With this new knowlegde I try to come up something similar as above. This is the code:

Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document

Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordAppEmbed = objSampleReport.Object.Application
Set wordAppNew = New Word.Application
Set wordFileNew = wordAppNew.Documents.Add

wordAppEmbed.Activate
wordAppEmbed.Selection.WholeStory
wordAppEmbed.Selection.Copy
wordAppNew.Activate
wordAppNew.Selection.PasteAndFormat

wordAppEmbed.Quit False

<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>

But this still result in header footer not been copy paste and the format still wrong. I try to play around with .PasteAndFormat type parameter but the result are still the same.

Can someone help me with this problem? My other option is to use the template as external word file and using the first code but that require me to send excel file and word file at the same time, and human error can occur if the user only copying the excel file.

Answer 1

May try Something in line with following code

Sub NewTest()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
'Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet
Set pgReport = ThisWorkbook.Sheets("Sheet1")  'Used for test purpose. May Use your choice

Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. Use use choice

objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
Set wordFileNew = wordAppEmbed.Documents.Add
wordFileEmbed.Content.Copy
wordFileNew.Range.Paste
wordFileEmbed.Close
' Now may Work with wordFileNew for further processing New file
End Sub

Edit As suggested by @Cindy Meister's expert opinion and valuable comment, I also feel first saving the embedded document as a new file, then open that document is far more prudent option. My last code is just an attempt to make your code work and tested on simple template only. (It may fail with complex documents). Therefore, I am posting modified code in line with @Cindy Meister's comment

Sub NewTest2()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet, Fname As String
Set pgReport = ThisWorkbook.Sheets("Sheet1") 'Modify to your choice
Fname = "C:\users\user\Desktop\Test2.docx"   'Modify to your choice

Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. May modify to your choice
objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
wordFileEmbed.SaveAs Fname
wordFileEmbed.Close
Set wordFileNew = wordAppEmbed.Documents.Open(Fname)

' Now may Work with wordFileNew for further processing New file

End Sub

.