麻辣家族討論版版 - Powered by Discuz! Board

Public Sub changeSource()
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 o nly 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
With ActiveDocument
fieldCount = .Fields.Count
For x = 1 To fieldCount
With .Fields(x)
'Debug.Print x '
Debug.Print .Type
If .Type = 56 Then
'only update Excel links. Type 56 is an excel link
.LinkFormat.SourceFullName = newFile '
.Update
.LinkFormat.AutoUpdate = False
DoEvents
End If
End With
Next x
End With
MsgBox "！更新完成！"
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
End Sub

複製代碼