VB脚本用于查找和替换多个Microsoft Word文档中的URL

Question

我需要替换100多个单词文档中的网址，并且正在寻找快速解决方案。

此代码有效但只能替换文本。如何更改它以替换超链接的URL？

Sub SearhAndReplace_MultipleFiles()

Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object

    Const strFolder = "C:\Users\dxgas0\Desktop\test\"
    Set FSO = CreateObject("scripting.filesystemobject")
    If Not FSO.folderexists(strFolder) Then
        MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
        Exit Sub
    End If
    Set ROOT = FSO.getfolder(strFolder & "\")
    processFolder ROOT.Path
    For Each fldr In ROOT.subfolders
        processFolder fldr.Path & "\"
    Next

End Sub

Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim rng As Word.Range
Dim fileSet As Object

    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)

        For Each rng In doc.StoryRanges

                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "http://www.url1.net"
                        .Replacement.Text = "http://www.url.com"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll

                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Answer 1

您现在的问题我认为您只是使用文档的文本范围。 Word对象模型包含一个Hyperlinks集合，该集合是可迭代的。从那里，您可以操纵该集合中每个超链接的TextToDisplay和Address属性。

您可能根本不需要使用.Find方法，请注意这一点，检查每个链接的.TextToDisplay属性并根据需要进行更新：

类似的东西：

Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim hyperlinks as Word.Hyperlinks
Dim link as Word.Links
Dim fileSet As Object

    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        Set hyperlinks = doc.hyperlinks
        For Each link In hyperlinks
            If link.TextToDisplay = "http://www.url1.net" Then
                'Change the address:
                link.Address = "http://www.url2.com"
                'Change the display text:
                link.TextToDisplay = "http://www.url2.com"
                'Ensure font size is 9:
                link.Range.Font.Size = 9
            End If
        Next
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

我用来测试它的示例代码：

Sub updatelink()
Dim doc As Document
Dim hyperlinks As hyperlinks
Dim link As Hyperlink

    Set doc = ActiveDocument
    Set hyperlinks = doc.hyperlinks
    For Each link In hyperlinks
        If link.TextToDisplay = "http://google.com" Then
            link.Address = "http://stackoverflow.com/"
            link.TextToDisplay = "http://stackoverflow.com/"
            link.Range.Font.Size = 9
        End If
    Next


End Sub

执行前：

执行后：