HOWTO edit/change/replace all hyperlinks in a document

Background

I had a document and needed to change all hyperlinks in an easy and quality assured way. This applies to Microsoft Word (probably many different versions)

One solution is the following script

1. First run this script to extract all hyperlinks to a file (c:\hyperlinks.txt)

   Sub FileHyperlinks()
     Dim HL As Hyperlink
     Dim href As String
     Dim f
   
     Set f = CreateObject("Scripting.FileSystemObject").CreateTextFile("c:\hyperlinks.txt", True)
     For Each HL In ActiveDocument.Hyperlinks
       href = HL.Address
       If href <> "" Then f.WriteLine (href)
     Next HL
     f.Close
   End Sub
   

2. Edit the file c:\hyperlinks.txt
   • Remove duplicates
   • Edit hyperlinks by writing the new one after a tab on each line
   • Exampel to change "../../docs/document.doc" to "../newdocs/document.doc" enter the following line:
     ../../docs/document.docTAB../newdocs/document.doc
   • Save new version of c:\hyperlinks.txt

3. Run this script to replace all hyperlinks you edited:

   Sub ReplaceHyperlinks()
     Dim f, A
     Dim href, s As String
     Dim HL As Hyperlink
     Dim HLs As New Collection
   
     Set f = CreateObject("Scripting.FileSystemObject").OpenTextFile("c:\hyperlinks.txt")
     Do While f.AtEndOfStream <> True
       s = f.Readline
       If s <> "" Then A = Split(s, Chr$(9))
       If A(1) <> "" Then HLs.Add Item:=A(1), Key:=A(0)
     Loop
     f.Close
   
     On Error Resume Next
     For Each HL In ActiveDocument.Hyperlinks
       href = HL.Address
       If href <> "" Then
         s = HLs.Item(href)
         If s <> "" Then HL.Address = s
       End If
     Next HL
   End Sub
   

More info/questions from: Subject: MSWord-Hyperlinks