Public Sub changeSource()
 
Set MyRange = ActiveDocument.Content
MyRange.Find.Execute FindText:="<Дата>", ReplaceWith:=Format(Date, "dd/mm/yyyy"), Replace:=wdReplaceAll
 
 
Dim dlgSelectFile As FileDialog 'FileDialog object '
Dim thisField As Field
Dim selectedFile As Variant
'must be Variant to contain filepath of selected item
Dim newFile As Variant
Dim fieldCount As Integer '
Dim x As Long
On Error GoTo LinkError
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
With dlgSelectFile
  .Filters.Clear 'clear filters
  .Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'filter for only Excel files
  'use Show method to display File Picker dialog box and return user's action
  If .Show = -1 Then
    'step through each string in the FileDialogSelectedItems collection
    For Each selectedFile In .SelectedItems
      newFile = selectedFile 'gets new filepath
    Next selectedFile
  Else 'user clicked cancel
    Exit Sub
  End If
End With
Set dlgSelectFile = Nothing
'update fields
With ActiveDocument
  fieldCount = .Fields.Count
  For x = 1 To fieldCount
    With .Fields(x)
      'Debug.Print x '
      Debug.Print .Type
      If .Type = 56 Then
        'only update Excel links. Type 56 is an excel link
        .LinkFormat.SourceFullName = newFile '
        .Update
        .LinkFormat.AutoUpdate = False
        DoEvents
      End If
    End With
  Next x
End With
MsgBox "Данные успешно обновлены"
Exit Sub
LinkError:
Select Case Err.Number
  Case 5391 'could not find associated Range Name
    MsgBox "Could not find the associated Excel Range Name " & _
      "for one or more links in this document. " & _
      "Please be sure that you have selected a valid " & _
      "Quote Submission input file.", vbCritical
  Case Else
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Select
End Sub