thanks nick i tried that, but ihad to specify the excel application for it to work as this is in word VBA. I also cut the code down so that it only changes links and odesnt up but its still slow. I cant understand this as when i only update the links using
Activedocument.fields.update
it is instantly finished. I know this is only updating and not changing the source but still the time difference is too big.
My full code is:
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
Add this: