HOWTO edit/change/replace all hyperlinks in a document

My problem

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

  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

microsoft,word,doc,hyperlink,hyperlinks,change,edit,replace,script,vb