Sub ChangeFileLinks()
    Dim f As Object
    Dim i, x, fieldCount As Long
    Dim OldPath, OldFile As String
    Dim NewPath, NewFile As String
    
    Set f = Application.FileDialog(3)

    f.AllowMultiSelect = False

    If f.Show Then
        For i = 1 To f.SelectedItems.Count
            'Get the File Path Only
            MsgBox "The New File Path is: " & f.InitialFileName
            NewPath = f.InitialFileName & "\"
            'Get the FileName only.  Uses Public FileName Function Below
            MsgBox "The FileName Only is: " & Filename(f.SelectedItems(i))
            NewFile = Filename(f.SelectedItems(i))
        Next
    End If
    
    With ActiveDocument
        fieldCount = .Fields.Count
        For x = 1 To fieldCount
            With .Fields(x)
                'Debug.Print .Type
                If .Type = 56 Then
                    'Get The Existing FilePath and File Name from the Link Sources
                    'MsgBox "The Existing FilePath is: " & .LinkFormat.SourcePath
                    OldPath = .LinkFormat.SourcePath
                    'MsgBox "The Existing File Name is: " & .LinkFormat.SourceName
                    OldFile = .LinkFormat.SourceName
                    
                    'Replace the FilePath
                    '.LinkFormat.SourcePath = NewPath
                    
                    'Replace the FileName
                    '.LinkFormat.SourceName = NewFile
                    
                    .Update
                End If
            End With
        Next x
    End With
    
    
End Sub

Public Function Filename(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        Filename = Filename(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function