VB Script to find and replace a URL in multiple Microsoft Word documents

Question

I need to replace URLs in over 100 word documents and was looking for a quick solution.

This code works but it only replaces text. How can I change it to replace hyperlinked URLs?

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

Your problem right now I think is that you're only working with the textrange of the document. The Word Object model contains a Hyperlinks collection, which is iterable. From there, you can manipulate the TextToDisplay and Address properties of each individual hyperlink in that collection.

You may not need to use the .Find method at all, with this in mind, check each link's .TextToDisplay property and update as needed:

Something like:

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

Example code that I used to test it:

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

Before execution:

After execution: