Change all links' sources in a Word document - Misplacement of Ranges

Question

I work on this code to change the sources of all linked Fields/Charts/... in Word templates to the workbook it is launched from.

I had usual fields and charts (which are stored in InlineShapes), so I have 2 loops for every template.

---

These loops sometimes stays stuck with For Each, and keep looping on Fields/InlineShapes (and don't even increase index...) without stopping. (I added the DoEvents for that, and it seems to reduce the frequency of that happening... if you have an explanation, it'll be very welcome!)

And with For i = ... to .Count, now it works pretty much flawlessly, except for Pasted Excel Range which are changed to a range of the same size, starting on A1 each time, and on the active sheet of the workbook.

---

To avoid problems with InlineShapes, I added a test to know if the LinkFormat.SourceFullName is accessible and therefore avoid an error that would stop the process :

Function GetSourceInfo(oShp As InlineShape) As Boolean
Dim test As Variant
    On Error GoTo Error_GetSourceInfo
    test = oShp.LinkFormat.SourceFullName
    GetSourceInfo = True
    Exit Function
Error_GetSourceInfo:
   GetSourceInfo = False
End Function

---

I noted 2 types of linked InlineShapes in my templates :

Charts

Pasted as Microsoft Office Graphic Object : .hasChart = -1 .Type = 12 .LinkFormat.Type = 8

Ranges

Pasted as Picture (Windows Metafile) : .hasChart = 0 .Type = 2 .LinkFormat.Type = 0

Here is my loop for InlineShapes :

For i = 1 To isCt
    If Not GetSourceInfo(oDoc.InlineShapes(i)) Then GoTo nextshape
        oDoc.InlineShapes(i).LinkFormat.SourceFullName = NewLink
        DoEvents
nextshape:
Next i

Question

As I only update the .SourceFullName, which only describe Path and File, I have no clue on why or how this affect the initially selected range...

Problem recap : Pasted Excel Range which are changed to a range of the same size, starting on A1 each time, and on the active sheet of the workbook.

And any other inputs on how to update Word links will be appreciated!

---

As suggested in Andrew Toomey's answer, I worked with HyperLinks but in each one of my templates, the collection is empty :

---

I've tried quite a lot of different combinations and here is what I cleaned :

Sub change_Templ_Args()

Dim oW As Word.Application, _
    oDoc As Word.Document, _
    aField As Field, _
    fCt As Integer, _
    isCt As Integer, _
    NewLink As String, _
    NewFile As String, _
    BasePath As String, _
    aSh As Word.Shape, _
    aIs As Word.InlineShape, _
    TotalType As String

On Error Resume Next
Set oW = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set oW = CreateObject("Word.Application")
On Error GoTo 0
oW.Visible = True

NewLink = ThisWorkbook.Path & "\" & ThisWorkbook.Name

BasePath = ThisWorkbook.Path & "\_Templates\"
NewFile = Dir(BasePath & "*.docx")

Do While NewFile <> vbNullString
    Set oDoc = oW.Documents.Open(BasePath & NewFile)
    fCt = oDoc.Fields.Count
    isCt = oDoc.InlineShapes.Count
    MsgBox NewFile & Chr(13) & "Fields : " & oDoc.Fields.Count & Chr(13) & "Inline Shapes : " & isCt

    For i = 1 to fCt 
        With oDoc.Fields(i)
            '.LinkFormat.AutoUpdate = False
            'DoEvents
            .LinkFormat.SourceFullName = NewLink
            '.Code.Text = Replace(.Code.Text, Replace(.LinkFormat.SourceFullName, "\", "\\"), Replace(NewLink, "\", "\\"))
        End With
    Next i

    For i = 1 To isCt
        If Not GetSourceInfo(oDoc.InlineShapes(i)) Then GoTo nextshape
            With oDoc.InlineShapes(i)
                .LinkFormat.SourceFullName = NewLink
                DoEvents
                'MsgBox .LinkFormat.SourceFullName & Chr(13) & Chr(13) & _
                        "Type | LF : " & .LinkFormat.Type & Chr(13) & _
                        "Type | IS : " & .Type & Chr(13) & _
                        "hasChart : " & .HasChart & Chr(13) & Chr(13) & _
                        Round((i / isCt) * 100, 0) & " %" 
            End With
nextshape:
    Next i

    MsgBox oDoc.Name & " is now linked with this workbook!"
    oDoc.Save
    oDoc.Close
    NewFile = Dir()
Loop
oW.Quit

Set oW = Nothing
Set oDoc = Nothing

MsgBox "All changes done.", vbInformation + vbOKOnly, "End proc"

End Sub

Answer 1

I think using the hyperlinks collection is the key to your solution - unless you have a specific reason not to. Links from a Word document to an Excel workbook are external links so should all be listed in the Hyperlinks collection (regardless of whether they are text links or InlineShapes that are linked).

Here's my code that may be of some help. For simplicity I've hard coded the Word document since that's not an issue for you:

Sub change_Templ_Args()
    WbkFullname = ActiveWorkbook.FullName

    'Alternatively...
    'WbkFullname = "C:\temp\myworkbook.xlsx"
    'Application.Workbooks.Open Filename:=WbkFullname

    'Get Document filename string
    MyWordDoc = "C\Temp\mysample.docx"

    Set oW = CreateObject("Word.Application")
    oW.Documents.Open Filename:=MyWordDoc 
    Set oDoc = oW.ActiveDocument

    'Reset Hyperlinks
    For Each HypLnk In oDoc.Hyperlinks
        HypLnk.Address = WbkFullname
    Next

End Sub

If you really need to use Fields and InlineShapes try this code. I've used variants in For loop and added a check for wdLinkTypeReference for fields that are Table of Contents or Cross Reference fields - these links are internal to the document.

'Reset links to InlineShapes
For Each InShp In ActiveDocument.InlineShapes
    If Not InShp.LinkFormat Is Nothing Then
        InShp.LinkFormat.SourceFullName = WbkFullname
    End If
    If InShp.Hyperlink.Address <> "" Then
        InShp.LinkFormat.SourceFullName = WbkFullname
    End If
Next

'Reset links to fields
For Each Fld In ActiveDocument.Fields
    If Not Fld.LinkFormat Is Nothing Then
        If Fld.LinkFormat.Type <> wdLinkTypeReference Then 
            Fld.LinkFormat.SourceFullName = WbkFullname
        End If
    End If
Next

Answer 2

Maybe not all Fields/Shapes are linked and the original insert of the field/shape resulted in not all properties being created on the object.

To advance your code and find out in more detail what is the matter with the objects, try to ignore and report errors. Use watches to inspect the objects.

For example:

On Error Goto fieldError
For Each aField In oDoc.Fields
    With aField
        .LinkFormat.AutoUpdate = False
        DoEvents
        .LinkFormat.SourceFullName = NewLink
        .Code.Text = Replace(.Code.Text, Replace(.LinkFormat.SourceFullName, "\", "\\"), Replace(NewLink, "\", "\\"))
        Goto fieldContinue
      fieldError:
        MsgBox "error: <your info to report / breakpoint on this line>"
      fieldContinue:
    End With
Next aField

P.s.: what is the purpose of DoEvents? That will process external events (Windows messages).