HOWTO edit/change/replace all hyperlinks in a document


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
    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:
    • 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)
      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