Update source to all excel links in word vba - excel

Question

I am trying to update the source to all the links in a word report by using a macro in word VBA. I want to be able to offer a dialog box to user then they select file and it replaces current source in all links in the word doc. The code i have below works but really slowly. I also seem to have to open excel in the background or the links wont work? not sure why this is??
It seems to go through eack link in tuen. Is there a way to globally change all the links at the same time possibly using find and repalce? please any help is greatly appreciated! I need this for a reprot in work and so i need to find a solution as soon as possible.
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 " & _
"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
' clean up
Set xlsfile_chart = Nothing
xlsobj.Quit
Set xlsobj = Nothing
End Sub

Answer 1

Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
On error go to 0
End With
If FolderName = "" Then
Exit Sub
End If
'Continue with code using FolderName as your source path
Hopefully this will serve as a good starting point for you. This will get you the path of the source folder and store it in FolderName. You can then build your link using:
CompletePath = FolderName + [FileNameGoesHere]
(Don't forget to make sure your FolderName has a "\" on the end, else the path will be incorrectly formatted, if it doesn't you can add it in or perform a check to ensure it is present on the end of the FolderName string