Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
Const strPath As String = "C:\NewPath\"
With ActiveDocument
  For i = .Shapes.Count To 1 Step -1
    With .Shapes(i)
      If Not .LinkFormat Is Nothing Then
        With .LinkFormat
          .SourceFullName = strPath & .SourceName
        End With
      End If
    End With
  Next
  For i = .InlineShapes.Count To 1 Step -1
    With .InlineShapes(i)
      If Not .LinkFormat Is Nothing Then
        With .LinkFormat
          .SourceFullName = strPath & .SourceName
        End With
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub