Updating Fields linked from Excel

[nikki333]

Hi Folks

I'm trying to insert text and objects (ie. tables/figures) from Excel into Word via "Insert Content" (Rich text format and Excel Objects, respectively; with the option "Insert as Link").
This works fine, as long as the Excel source file is open. However, when the source file is closed, Word will complain.

I've been following the instructions of a Youtube video where exactly the same procedure obviously worked without having the source file open (https://www.youtube.com/watch?v=kz8VgfWbDr4).

Any ideas?

[Aussiebear]

Maybe this might be useful


Sub InsertExcelContentIntoWord()
Dim wdApp As Object
' Word.Application
Dim wdDoc As Object
' Word.Document
Dim xlFilePath As String
Dim objWord As Object
Dim objDoc As Object
' Configuration
xlFilePath = "C:\Path\To\Your\ClosedExcelFile.xlsx" ' <--CHANGE THIS TO YOUR EXCEL FILE PATH
Const WORD_FILE_PATH As String = "C:\Path\To\Your\TargetWordDocument.docx" ' <-CHANGE THIS TO YOUR WORD FILE PATH
Const INSERT_LOCATION As String = "EndOfDoc"
' Or specify a bookmark name like "MyBookmark"
' Error Handling
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
' Create Word Application if it's not running
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
' Optional: Make Word visible
End If
' Open the Word Document
On Error Resume Next
Set wdDoc = wdApp.Documents(WORD_FILE_PATH)
On Error GoTo 0
If wdDoc Is Nothing Then
Set wdDoc = wdApp.Documents.Open(WORD_FILE_PATH)
End If
' Determine the insertion range
Dim objRange As Object
Select Case UCase(INSERT_LOCATION)
Case "ENDOFOOC"
Set objRange = wdDoc.Content
objRange.Collapse wdCollapse
End Case
Else
' Assume it's a bookmark name
On Error Resume Next
Set objRange = wdDoc.Bookmarks(INSERT_LOCATION).Range
On Error GoTo 0
If objRange Is Nothing Then
MsgBox "Bookmark '" & INSERT_LOCATION & "' not found in the Word document.", vbExclamation
GoTo Cleanup
End If
End Select
' Insert Content as Linked Rich Text (for all sheets)
Dim objExcel As Object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
' Keep Excel hidden
End If
Dim wb As Object
On Error Resume Next
Set wb = objExcel.Workbooks(xlFilePath)
On Error GoTo 0
If wb Is Nothing Then
Set wb = objExcel.Workbooks.Open(xlFilePath, ReadOnly:=True)
End If
Dim ws As Object
For Each ws In wb.Sheets
' Insert the entire sheet as linked Rich Text
objRange.InsertFile FileName:=xlFilePath, Range:=ws.Name, ConfirmConversions:=False, Link:=True, Attachment:=False
objRange.Collapse wdCollapseEnd
' Move insertion point to the end
objRange.InsertParagraphAfter
' Add a new line after each sheet
Next ws
' Insert Content as Linked Excel Objects (for all charts and shapes)
Dim objChart As Object
Dim objShape As Object
For Each ws In wb.Sheets
For Each objChart In ws.ChartObjects
objChart.Copy
objRange.PasteSpecial Link:=True, DataType:=wdPasteOLEObject
objRange.Collapse wdCollapseEnd
objRange.InsertParagraphAfter
Next objChart
For Each objShape In ws.Shapes
If objShape.Type <> msoEmbeddedOLEObject Then
' Avoid duplicating chart objects
On Error Resume Next
objShape.Copy
If Err.Number = 0 Then
objRange.PasteSpecial Link:=True, DataType:=wdPasteOLEObject
objRange.Collapse wdCollapseEnd
objRange.InsertParagraphAfter
Else
Err.Clear
End If
On Error GoTo 0
End If
Next objShape
Next ws
' Clean up
Cleanup:
If Not wb Is Nothing Then
wb.Close SaveChanges:=False
End If
If objExcel Is Nothing Then
' If we created Excel, we might want to quit it (optional)
' objExcel.Quit
End If
Set wb = Nothing
Set objExcel = Nothing
Set objRange = Nothing
Set wdDoc = Nothing
' Do NOT set wdApp to Nothing if Word was already open
MsgBox "Content from '" & xlFilePath & "' inserted into '" & WORD_FILE_PATH & "' with links.", vbInformation
End Sub