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

我需要替换100多个word文档中的URL，并正在寻找快速解决方案

此代码可以工作，但它只替换文本。如何更改它以替换超链接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

---

我认为您现在的问题是，您只处理文档的textrange。Word对象模型包含一个可编辑的超链接集合。从那里，您可以操作该集合中每个超链接的

文本显示

和

地址

属性

您可能根本不需要使用

.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

执行前：

执行后：