Try:
Code:
Sub UpdateLinks()
' This routine updates all external links, pointing them all to a single selected file.
' Turn Off Screen Updating temporarily.
Application.ScreenUpdating = False
Dim TrkStatus As Boolean, Pwd As String, pState As Boolean, StrFlNm As String
Dim Rng As Range, Fld As Field, Shp As Shape, iShp As InlineShape
' Select the new source file for the links
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select the new source file"
.InitialFileName = ActiveDocument.Path
.Filters.Clear 'clear filters
.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'filter for only Excel files
.AllowMultiSelect = False
If .Show = -1 Then
StrFlNm = .SelectedItems(1)
Else
MsgBox "No new source file selected. Exiting", vbExclamation
Exit Sub
End If
End With
With ActiveDocument
' If used, 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
' Store current Track Changes status, then switch off temporarily.
TrkStatus = .TrackRevisions
.TrackRevisions = False
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
' Replace the link to the external file.
.LinkFormat.SourceFullName = StrFlNm
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
' Replace the link to the external file.
.LinkFormat.SourceFullName = StrFlNm
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
' Replace the link to the external file.
.LinkFormat.SourceFullName = StrFlNm
End If
End With
Next Fld
Next Rng
' Restore original Track Changes status
ActiveDocument.TrackRevisions = TrkStatus
' 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.
.Save
End With
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub