Question

我正在尝试使用单词VBA中的宏将源更新为单词报告中的所有链接。我希望能够为用户提供一个对话框，然后他们选择文件并替换word doc中所有链接中的当前源。我下面的代码有效但很慢。我似乎也必须在后台打开excel或链接不能工作？不知道为什么这是??

似乎在屯中经历了eack链接。有没有办法可以使用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字符串

的末尾

更新word vba中所有excel链接的源代码

1 个答案: