Update the file paths dynamically in network drives using Word VBA

I'm trying to create an Excel object in Word which reflects live update of data from Excel.

My use case is to update the object path dynamically when two files, Word and Excel are being sent to someone and the link should not break.

I found code that works with local drive.

Option Explicit

' Word macro to automatically update field links to other files
' Created by Paul Edstein (aka macropod). Posted at:
' http://windowssecrets.com/forums/showthread.php/154379-Word-Fields-and-Relative-Paths-to-External-Files
Dim TrkStatus As Boolean      ' Track Changes flag
Dim Pwd As String ' String variable to hold passwords for protected documents
Dim pState As Boolean ' Document protection state flag

Sub AutoOpen()
' This routine runs whenever the document is opened.
' It calls on the others to do the real work.
'
' Prepare the environment.
With ActiveDocument
    ' Insert your document's password between the double quotes on the next line
    Pwd = ""
    ' Initialise the protection state
    pState = False
    ' If the document is protected, unprotect it
    If .ProtectionType <> wdNoProtection Then
        ' Update the protection state
        pState = True
        ' Unprotect the document
        .Unprotect Pwd
    End If
    Call MacroEntry
    ' Most of the work is done by this routine.
    Call UpdateFields
    ' Go to the start of the document
    Selection.HomeKey Unit:=wdStory
    ' Clean up and exit.
    Call MacroExit
    ' If the document was protected, reprotect it, preserving any formfield contents
    If pState = True Then .Protect wdAllowOnlyFormFields, Noreset:=True, Password:=Pwd
    ' Set the saved status of the document to true, so that changes via
    ' this code are ignored. Since the same changes will be made the
    ' next time the document is opened, saving them doesn't matter.
    .Saved = True
End With
End Sub

Private Sub MacroEntry()
' Store current Track Changes status, then switch off temporarily.
With ActiveDocument
    TrkStatus = .TrackRevisions
    .TrackRevisions = False
End With
' Turn Off Screen Updating temporarily.
Application.ScreenUpdating = False
End Sub

Private Sub MacroExit()
' Restore original Track Changes status
ActiveDocument.TrackRevisions = TrkStatus
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub

Private Sub UpdateFields()
' This routine sets the new path for external links, pointing them to the current folder.
Dim Rng As Range, Fld As Field, Shp As shape, iShp As InlineShape, i As Long
Dim OldPath As String, NewPath As String, Parent As String, Child As String, StrTmp As String
' Set the new path.
' If your files are always in a folder whose path bracnhes off, one or more levels above the current
' folder, replace the second '0' on the next line with the number of levels above the current folder.
For i = 0 To UBound(Split(ActiveDocument.Path, "\")) - 0
  Parent = Parent & Split(ActiveDocument.Path, "\")(i) & "\"
Next i
' If your files are in a Child folder below the (new) parent folder, add the Child folder's
' path from the parent (minus the leading & trailing "\" path separators) on the next line.
Child = ""
NewPath = Parent & Child
' Strip off any trailing path separators.
While Right(NewPath, 1) = "\"
  NewPath = Left(NewPath, Len(NewPath) - 1)
Wend
NewPath = NewPath & "\"
' Go through all story ranges in the document.
With ThisDocument
  For Each Rng In .StoryRanges
    ' Go through the shapes in the story range.
    For Each Shp In Rng.ShapeRange
      With Shp
        ' Skip over shapes that don't have links to external files.
        If Not .LinkFormat Is Nothing Then
          With .LinkFormat
            OldPath = Left(.SourceFullName, InStrRev(.SourceFullName, "\"))
            ' Replace the link to the external file if it differs.
            If OldPath <> NewPath Then
              .SourceFullName = Replace(.SourceFullName, OldPath, NewPath)
              On Error Resume Next
              .AutoUpdate = False
              On Error GoTo 0
            End If
          End With
        End If
      End With
    Next Shp
    ' Go through the inlineshapes in the story range.
    For Each iShp In Rng.InlineShapes
      With iShp
        ' Skip over inlineshapes that don't have links to external files.
        If Not .LinkFormat Is Nothing Then
          With .LinkFormat
            OldPath = Left(.SourceFullName, InStrRev(.SourceFullName, "\"))
            ' Replace the link to the external file if it differs.
            If OldPath <> NewPath Then
              .SourceFullName = Replace(.SourceFullName, OldPath, NewPath)
              On Error Resume Next
              .AutoUpdate = False
              On Error GoTo 0
            End If
          End With
        End If
      End With
    Next iShp
    ' Go through the fields in the story range.
    For Each Fld In Rng.Fields
      With Fld
        ' Skip over fields that don't have links to external files.
        If Not .LinkFormat Is Nothing Then
          With .LinkFormat
            OldPath = Left(.SourceFullName, InStrRev(.SourceFullName, "\"))
            ' Replace the link to the external file if it differs.
            If OldPath <> NewPath Then
              .SourceFullName = Replace(.SourceFullName, OldPath, NewPath)
              On Error Resume Next
              .AutoUpdate = False
              On Error GoTo 0
            End If
          End With
        End If
      End With
    Next Fld
  Next Rng
  .Save
End With
End Sub

When I run this code in network drive, it keeps loading.

I edited the code and it started to update the links but also started creating same link object in the next line and that process started blinking like an endless loop.

Here is the manual trigger code:

Option Explicit

Sub UpdateLinksManual()
    On Error GoTo ErrorHandler

    Dim doc As Document
    Set doc = ActiveDocument

    ' Call the main routine to update links
    UpdateLinks doc

    ' Save the document
    doc.Save

Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description
End Sub

Sub UpdateLinks(doc As Document)
    On Error GoTo ErrorHandler

    Dim newPath As String
    newPath = doc.Path & "\"

    ' Update shapes
    Dim shapesCopy As Shapes
    Set shapesCopy = doc.Shapes.Duplicate ' Create a copy to avoid modification during iteration
    For Each shp In shapesCopy
        UpdateLinkFormat shp.LinkFormat, newPath
    Next shp

    ' Update inline shapes
    ' ... (similar approach for inline shapes and fields)

Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description
End Sub

Sub UpdateLinkFormat(LinkFmt As Object, NewPath As String)
    If Not LinkFmt Is Nothing Then
        Dim oldPath As String
        oldPath = Left(LinkFmt.SourceFullName, InStrRev(LinkFmt.SourceFullName, "\"))

        If oldPath <> NewPath Then
            LinkFmt.SourceFullName = Replace(LinkFmt.SourceFullName, OldPath, NewPath)
            LinkFmt.AutoUpdate = False
        End If
    End If
End Sub