koppeling naar Excel in header

Sub changeSource()
Dim fieldCount As Integer, x As Long
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


'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)


With dlgSelectFile
  .Title = "Select the new source file"
  .InitialFileName = ActiveDocument.Path
  .Filters.Clear 'clear filters
  .Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'filter for only Excel files
  .AllowMultiSelect = False
'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
    End If
End With
Set dlgSelectFile = Nothing

With ActiveDocument
  fieldCount = .Fields.Count
  For x = 1 To fieldCount
    With .Fields(x)
'      If .Type = 56 Then
'        'only update Excel links. Type 56 is an excel link
        Debug.Print .LinkFormat.SourceFullName
        .LinkFormat.SourceFullName = NewFile '
        .Update
        .LinkFormat.AutoUpdate = False
        DoEvents
'      End If
    End With
  Next x
End With

End Sub

Dim oStory As Object
Dim fld As Field
    With ActiveDocument
        For Each oStory In .StoryRanges
            For Each fld In oStory.Fields
                If .Type = 56 Then
                    fld.LinkFormat.SourceFullName = NewFile
                    fld.Update
                    fld.LinkFormat.AutoUpdate = False
                    DoEvents
                End If
            Next fld
        Next oStory
    End With

Sub CountFields()
    

    MsgBox ActiveDocument.Fields.Count

End Sub