查找并替换外部来源的超链接

Question

我有一些 Word 文件，需要替换外部源的超链接。

我在单独的 Word 文档中有一个表格，其中第 1 列是文档名称（我希望显示的文本），第 2 列是 URL。

我想在文件中搜索第 1 列中的文档名称，并使用第 2 列的内容添加/替换现有 URL。
理想情况下，我想强调这一点，看看它在哪里有效，在哪里无效。

代码不会产生错误，但也不会添加超链接。

Sub Links()

Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String

sFname = "myexternaltablespathway.docx"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
Options.DefaultHighlightColorIndex = wdYellow

For i = 1 To oTable.Rows.Count
    Set oRng = oDoc.Range
    Set rFindText = oTable.Cell(i, 1).Range
    rFindText.End = rFindText.End - 1
    Set rHyperlink = oTable.Cell(i, 2).Range
    rHyperlink.End = rHyperlink.End - 1
    Selection.HomeKey wdStory
    With oRng.Find
        .MatchWildcards = True
        .Text = (rFindText.Text)
        .Highlight = True

        ActiveDocument.Hyperlinks.Add Anchor:=rFindText, Address:= _
          "rHyperlink"

        .Forward = True
        .Wrap = wdFindContinue
    End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub 

Answer 1

请尝试这个：

Sub Links()
    
    Dim oDoc As Document, oChanges As Document
    
    Dim oTable As Table
    Dim oRng As Range
    
    'Dim rFindText As Range, rReplacement As Range
    Dim rFindText As String, rHyperlink As String
    
    Dim i As Long
    Dim sFname As String
    
    sFname = "myexternaltablespathway.docx"'this sFname must be a full name of the file
    Set oDoc = ActiveDocument
    Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
    Set oTable = oChanges.Tables(1)
'    Options.DefaultHighlightColorIndex = wdYellow
    
    For i = 1 To oTable.rows.Count
        Set oRng = oDoc.Range
        'Set rFindText = oTable.cell(i, 1).Range
        'rFindText.End = rFindText.End - 1
        rFindText = oTable.cell(i, 1).Range.Text
        rFindText = Left(rFindText, Len(rFindText) - 2)
        
        'Set rHyperlink = oTable.cell(i, 2).Range
        'rHyperlink.End = rHyperlink.End - 1
        rHyperlink = oTable.cell(i, 2).Range.Text
        rHyperlink = Left(rHyperlink, Len(rHyperlink) - 2)
        
        'Selection.HomeKey wdStory
        With oRng.Find
        
            Rem why use the wildcards?
            '.MatchWildcards = True
            
    '        .Text = (rFindText.Text)
            .Text = rFindText
            
'            .Highlight = True 'this will find the range be highlighted
            
'            ActiveDocument.Hyperlinks.Add Anchor:=rFindText, Address:= _
'                "rHyperlink" ' this line is wrong!!!
            
            .Forward = True
            .Wrap = wdFindStop 'wdFindContinue
            .Execute
            Do While .Found()
                If .Parent.Hyperlinks.Count > 0 Then
                    Dim lnk As Hyperlink
                    For Each lnk In .Parent.Hyperlinks
                        lnk.Delete
                    Next lnk
                End If
                .Parent.Hyperlinks.Add Anchor:=oRng, _
                                    Address:=rHyperlink
                .Parent.HighlightColorIndex = wdYellow
                .Parent.SetRange .Parent.End, oDoc.Range.End
                .Execute
            Loop
        End With
    Next i
    oChanges.Close wdDoNotSaveChanges
End Sub