Hyperlinking multiple words in a document

[WizHock]

Is there a way to Hyperlink all of the same word in a Document with the same link? Say I want to have every instance of "dog" to be Hyperlinked to "somepath.html", what code would I need to do that? I'm not too familiar with VBA methods or properties so I'll need a little bit of explanation as to what each does.

Thanks in Advance!

WizHock

[Nelviticus]

This should work - just run the 'WordsToLinks' method and replace the parameters with whatever you like:
Public Sub WordsToLinks()

Call LinkWord("dog", "somepath.html")

End Sub

Public Sub LinkWord(SearchWord As String, HyperLink As String)

Dim ThisWord As Range ' The Range of the current Word
Dim lWord As Long ' Word counter

lWord = 1

With ActiveDocument

' Loop through all the Words in the document
While lWord < .Words.Count

' Grab the Range of the current Word
Set ThisWord = .Words(lWord)

' If the current Word matches the one we want
' (ignoring case and extra spaces)
If LCase(Trim(ThisWord.Text)) = SearchWord Then

' Shrink the Range to remove any spaces, otherwise
' the link will be the Word plus the space after it
With ThisWord
.End = .End - Len(.Text) + Len(Trim(.Text))
End With

' Add a hyperlink to it
.Hyperlinks.Add _
Anchor:=ThisWord, _
Address:=HyperLink, _
TextToDisplay:=ThisWord.Text

End If

' Step to the next word
lWord = lWord + 1

Wend

End With

Set ThisWord = Nothing

End Sub
Regards

[WizHock]

I've tried a few words (so far 'the' and 'First') and it will get to the first word to be linked in the document, and then crash. No error message, just a plain old crash.

[Nelviticus]

Hmm, well that's a bug in Word then. What version are you using? I'm on Office 2007.

You could try running the code from the VB editor by pressing F8 repeatedly - this will step through one instruction at a time so at least you'll be able to figure out which line is causing the crash. If it's a bug in Word though there's not much I can do about it :(

[WizHock]

Yea, I think it is a bug. However it just worked on my third try, so I dunno.

Thanks!

[WizHock]

Actually, now that I've played around with it a little, it only works for lower case words. I tried to link the word 'Page' and it didn't do anything, but when I changed every 'Page' to 'page' it worked. I took out the LCase in LinkWord and everything worked super. That was causing the Macro to only work on lower case words.

[Nelviticus]

Ah yes, I'm not sure why I put that in - it seemed like a good idea at the time!

[WizHock]

Another question:
How would I be able to link the words in the footer as opposed to just the body?

[mdmackillop]

Another version using a Find method

Option Explicit
Option Base 1
Sub AddLinks()
Dim txt As String
Dim Lgth As Long
Dim i As Long
Dim oRng As Range
Dim col As Long
Dim hLink As String
Dim ChkRng As Range
Dim Wds As Long
'Set parameters
hLink = InputBox("Enter hyperlink", , "C:\AAA\Test1.doc")
txt = InputBox("String to find")
Lgth = Len(txt)
'Search Word Document
Set oRng = ActiveDocument.Range
Set ChkRng = ActiveDocument.Range
oRng.Collapse wdCollapseStart
ChkRng.Collapse wdCollapseStart
'Return data to array
With oRng
With .Find
.ClearFormatting
.Forward = True
.Text = txt
.Execute
While .Found
oRng.SetRange Start:=oRng.Start, End:=oRng.Start + Lgth
ChkRng.SetRange Start:=0, End:=oRng.End
'Get last word
Wds = ChkRng.Words.Count
'Add link if range is whole word
If Trim(ChkRng.Words(Wds)) = oRng Then
oRng.Hyperlinks.Add _
Anchor:=oRng, _
Address:=hLink, _
TextToDisplay:=oRng.Text
i = i + 1
End If
oRng.Start = oRng.End + 1
.Execute
Wend
End With
End With
MsgBox i & " links added."
End Sub