Обновление источника для всех ссылок excel в слове vba

Question

Я пытаюсь обновить источник до всех ссылок в текстовом отчете, используя макрос в слове VBA. Я хочу иметь возможность предлагать пользователю диалоговое окно, затем они выбирают файл, и он заменяет текущий источник во всех ссылках в слове doc. Код, который я ниже, работает, но очень медленно. Мне также кажется, что нужно открыть excel в фоновом режиме или ссылки не будут работать? не уверен, почему это?

Кажется, что вы можете использовать ссылку eack в tuen. Есть ли способ глобально изменить все ссылки в то же время, возможно, используя find и repalce? пожалуйста, любая помощь очень ценится! Мне нужно это для повторения в работе, и поэтому мне нужно найти решение как можно скорее.

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 

Надеюсь, это послужит хорошей отправной точкой для вас. Это даст вам путь к исходной папке и сохранит ее в FolderName. Затем вы можете создать свою ссылку с помощью:

CompletePath = FolderName + [FileNameGoesHere]

(Не забудьте убедиться, что ваш FolderName имеет «\» на конце, иначе путь будет неправильно отформатирован, если это не вы может добавить его или выполнить проверку, чтобы убедиться, что он присутствует в конце строки FolderName