Save embedded documents

[sharky12345]

Can someone give me some advice on how I can save 2 embedded Word documents?

I have 2 Word templates embedded in my Excel workbook and I want to extract them and save them to the same path as the workbook - I don't want to open them, just save them.

Anyone?

 

[John_w]

Try this. It requires a reference to MS Word Object Library and assumes the two Word objects are named "Object 1" and "Object 2" on Sheet1.

Public Sub Save_Embedded_Word_Documents()

    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim WordFileName As String
    Dim embeddedWordDocument As Object
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then 'Word isn't already running
        Set WordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    WordApp.Visible = False
    
    'Open and save Word document object "Object 1" on Sheet1
    
    Set embeddedWordDocument = ThisWorkbook.Sheets("Sheet1").OLEObjects("Object 1")
    embeddedWordDocument.Verb Verb:=xlOpen

    Set WordDoc = WordApp.ActiveDocument
    WordDoc.SaveAs ThisWorkbook.Path & "/Embedded_Document1_Saved.docx", FileFormat:=wdFormatXMLDocument
    WordDoc.Close True
    
    'Open and save Word document object "Object 2" on Sheet1
    
    Set embeddedWordDocument = ThisWorkbook.Sheets("Sheet1").OLEObjects("Object 2")
    embeddedWordDocument.Verb Verb:=xlOpen

    Set WordDoc = WordApp.ActiveDocument
    WordDoc.SaveAs ThisWorkbook.Path & "/Embedded_Document2_Saved.docx", FileFormat:=wdFormatXMLDocument
    WordDoc.Close True
    
    WordApp.Quit False
    
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set embeddedWordDocument = Nothing
  
End Sub

 

[sharky12345]

Thanks John, this works great...

Can I ask one more thing though?

Is there a way I can hide the document whilst it is being opened? I have tried setting the screenupdating to false but that does nothing.

Thanks!

 

[John_w]

It seems you can't hide the document on opening because the Verb:=xlOpen command briefly shows the document.

I have added WordApp.WindowState = wdWindowStateMinimize and moved WordApp.Visible = False after each open, but the documents are still visible briefly.

Public Sub Save_Embedded_Word_Documents()

    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim WordFileName As String
    Dim embeddedWordDocument As Object
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then 'Word isn't already running
        Set WordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    WordApp.WindowState = wdWindowStateMinimize

    'Open and save Word document object "Object 1" on Sheet1
    
    Set embeddedWordDocument = ThisWorkbook.Sheets("Sheet1").OLEObjects("Object 1")
    embeddedWordDocument.Verb Verb:=xlOpen
    WordApp.Visible = False
    
    Set WordDoc = WordApp.ActiveDocument
    WordDoc.SaveAs ThisWorkbook.Path & "/Embedded_Document1_Saved.docx", FileFormat:=wdFormatXMLDocument
    WordDoc.Close False
    
    'Open and save Word document object "Object 2" on Sheet1
    
    Set embeddedWordDocument = ThisWorkbook.Sheets("Sheet1").OLEObjects("Object 2")
    embeddedWordDocument.Verb Verb:=xlOpen
    WordApp.Visible = False

    Set WordDoc = WordApp.ActiveDocument
    WordDoc.SaveAs ThisWorkbook.Path & "/Embedded_Document2_Saved.docx", FileFormat:=wdFormatXMLDocument
    WordDoc.Close False
    
    WordApp.Quit False
    
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set embeddedWordDocument = Nothing
  
End Sub

 

[sharky12345]

Cheers John - very much appreciated!