title: Word VBA: Update OLE Source Links
body: <p>I have about a dozen linked excel OLE objects in my word document.  These files get moved around the network frequently so I need an easy intuitive way for the underlying links to be updated.  I tried a code I found on this website however while it updated the source it seems to also update what is being shown in the object itself so all the objects change to whatever worksheet was in focus when the excel workbook was saved last.  I'm trying to retain format and range while updating the source. Any help would be great.</p>
  
  <p>Here is the code I tried presently:</p>
  
  <pre><code>Private Sub CommandButton1_Click()
  
  Dim OldFile As String
  Dim xlsobj As Object
  Dim xlsfile_chart As Object
  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
  
  
  
   Set xlsobj = CreateObject("Excel.Application")
   xlsobj.Application.Visible = False
   Set xlsfile_chart = xlsobj.Application.Workbooks.Open(newFile, ReadOnly = 
  True)
  
   Application.ScreenUpdating = False
  
    With xlsobj.Application
   .calculation = xlcalculationmanual
   .enableevents = False
   End With
  
  
  
    fieldCount = ActiveDocument.Fields.Count
     For x = 1 To fieldCount
     With ActiveDocument.Fields(x)
     If .Type = 56 Then
    .LinkFormat.SourceFullName = newFile
      End If
     End With
    Next x
  
    With xlsobj.Application
   .calculation = xlcalculationmanual
   .enableevents = True
   End With
  
   Application.ScreenUpdating = True
  
  
  
    MsgBox "Data has been sucessfully linked to report"
  
     'clean up
      xlsfile_chart.Close SaveChanges:=False
     Set xlsfile_chart = Nothing
     xlsobj.Quit
     Set xlsobj = Nothing
  
  
      Exit Sub
  LinkError:
    Select Case Err.Number
     Case 5391 'could not find associated Range Name
      MsgBox "Could not find the associated Excel Range Name " &amp; _
     "for one or more links in this document. " &amp; _
     "Please be sure that you have selected a valid " &amp; _
     "Quote Submission input file.", vbCritical
      Case Else
      MsgBox "Error " &amp; Err.Number &amp; ": " &amp; Err.Description, vbCritical
     End Select
  
  
     ' clean up
      Set xlsfile_chart = Nothing
       xlsobj.Quit
       Set xlsobj = Nothing
  
      End Sub
  </code></pre>