Microsoft Word - Create Hyperlinks from words, using a reference list

rG-tom · 5 Jun 2019 at 14:25

Hi all,

I quite often need to have words in a document replaced with hyperlinks, which currently means manually going through to where they are, and adding a hyperlink by copying the URL from a reference table. This is fine if there's ~5 links to do, but some times there can be 50-100+ of these. Ideally, I need to be able to search an entire document, and wherever a word that is in my reference table exists, add the hyperlink from the hyperlink field

ie ref table would be two columns:

WORD | HYPERLINK
wordA | "Z:\folder\folder\wordA.docx"
wordB | "Z:\folder\folder\wordB_rev2.xlsx"

and I'd want "WordA" in the doc to have a hyperlink added to "Z:\folder\folder\wordA.docx", but still retain other formatting and still just say "WordA"

Is there any software that can achieve this, or someone that understands macros a lot better than I able ot point me in the right direction?

Thanks!

AHarvey · 5 Jun 2019 at 17:34

If you can figure out how to type the URL out like in HTML instead of typing the word, selecting it and then creating a hyperlink, you could use Autohotkey hotstrings to create them as you type.

so in HTML you type in wordA and AutoHotkey changes it to <a href="URL">wordA</>

I'm not sure if you can create a hyperlink in Word in a similar way though.

Quartz · 5 Jun 2019 at 18:10

I'm sure a guru will be along shortly, but a halfway house would be a Glossary. That is, you have a table in Word with the links, then the words in your document link to words in that table. This could actually be more elegant as the level of indirection means that changes can be more easily managed.

https://www.techrepublic.com/article/how-to-add-a-traditional-glossary-to-a-microsoft-word-document/

https://www.tckpublishing.com/how-to-create-glossary-word/

Vince · 5 Jun 2019 at 18:12

rG-tom said:
Hi all,

I quite often need to have words in a document replaced with hyperlinks, which currently means manually going through to where they are, and adding a hyperlink by copying the URL from a reference table. This is fine if there's ~5 links to do, but some times there can be 50-100+ of these. Ideally, I need to be able to search an entire document, and wherever a word that is in my reference table exists, add the hyperlink from the hyperlink field

ie ref table would be two columns:

WORD | HYPERLINK
wordA | "Z:\folder\folder\wordA.docx"
wordB | "Z:\folder\folder\wordB_rev2.xlsx"

and I'd want "WordA" in the doc to have a hyperlink added to "Z:\folder\folder\wordA.docx", but still retain other formatting and still just say "WordA"

Is there any software that can achieve this, or someone that understands macros a lot better than I able ot point me in the right direction?

Thanks!

Vba this is really simple in vba. I'm guessing it's for work so this depends on how locked down your office install is.

rG-tom · 5 Jun 2019 at 19:22

Vince said:
Vba this is really simple in vba. I'm guessing it's for work so this depends on how locked down your office install is.

VBA is fine, I just don't know what VBA to use

I've managed to get a semi-bodge working by getting excel to inject the call parameters and i then copy and paste the bold text from excel into word, and run.

This is slightly clunkier than looking at a list directly, it's still a lot better than manual, but it only works on the main text and footnotes get ignored:

Code:

Sub run()

Call FindAndHyperlink1("WordA", "Z:\folder\folder\wordA.docx")
Call FindAndHyperlink1("wordB", "Z:\folder\folder\wordB_rev2.xlsx")



End Sub


Sub FindAndHyperlink1(strsearch As String, straddress As String)
    Dim rngSearch As Range
    Set rngSearch = ActiveDocument.Range
     
    With rngSearch.Find
        Do While .Execute(findText:=strsearch, MatchWholeWord:=False, Forward:=True) = True
            With rngSearch
                ActiveDocument.Hyperlinks.Add Anchor:=rngSearch, Address:=straddress
            End With
            rngSearch.Collapse Direction:=wdCollapseEnd
        Loop
    End With
End Sub

Any ideas what needs changing to get it to look in footnotes? I understand they're a different story range or something and can find plenty of examples of how to change for find and replace, but can't seem to get any of them to work for this.

Vince · 5 Jun 2019 at 19:29

rG-tom said:
VBA is fine, I just don't know what VBA to use

I've managed to get a semi-bodge working by getting excel to inject the call parameters and i then copy and paste the bold text from excel into word, and run.

This is slightly clunkier than looking at a list directly, it's still a lot better than manual, but it only works on the main text and footnotes get ignored:

Code:

Sub run() Call FindAndHyperlink1("WordA", "Z:\folder\folder\wordA.docx") Call FindAndHyperlink1("wordB", "Z:\folder\folder\wordB_rev2.xlsx") End Sub Sub FindAndHyperlink1(strsearch As String, straddress As String) Dim rngSearch As Range Set rngSearch = ActiveDocument.Range With rngSearch.Find Do While .Execute(findText:=strsearch, MatchWholeWord:=False, Forward:=True) = True With rngSearch ActiveDocument.Hyperlinks.Add Anchor:=rngSearch, Address:=straddress End With rngSearch.Collapse Direction:=wdCollapseEnd Loop End With End Sub

Any ideas what needs changing to get it to look in footnotes? I understand they're a different story range or something and can find plenty of examples of how to change for find and replace, but can't seem to get any of them to work for this.

Only just in and having some grub but later on tonight I'll build a little demo script. I think I've got what you are trying to do personally I'd probably approach it slightly differently and write all the vba in a word macro rather than starting in excel. Either that or in excel have everything and then a field that is changeable and allows you to select a target document.

I've written a ton of vba that we use in outlook and pulls in from databases all over the show so looking at this it sounds like it should be easy.

Just to be clear you write the document then want to find all words that might be in the spreadsheet and replace them with a corresponding hyperlink?

rG-tom · 5 Jun 2019 at 19:32

Vince said:
Only just in and having some grub but later on tonight I'll build a little demo script. I think I've got what you are trying to do personally I'd probably approach it slightly differently and write all the vba in a word macro rather than starting in excel. Either that or in excel have everything and then a field that is changeable and allows you to select a target document.

I've written a ton of vba that we use in outlook and pulls in from databases all over the show so looking at this it sounds like it should be easy.

Cheers!

The starting data set is in excel, ie the table with the two columns, which given i don't know how to get word to pull data from a spreadsheet, it seemed a logical bodge to get the spreadsheet to give me the VBA

Vince · 5 Jun 2019 at 19:36

rG-tom said:
Cheers!

The starting data set is in excel, ie the table with the two columns, which given i don't know how to get word to pull data from a spreadsheet, it seemed a logical bodge to get the spreadsheet to give me the VBA

Ok so you need system.io and some other classes to find, open etc the document. Then read the two ranges (not cells) into an array then loop through the doc comparing every word to the array. Then replace with the corresponding hyperlink in the second array. I think that is what I would do.

That has to be more efficient than looping through the document multiple times. Let me have a look a bit later, I have something pretty similar so i can probably steal a load of the code to make it a bit easier.

rG-tom · 5 Jun 2019 at 19:54

Vince said:
Ok so you need system.io and some other classes to find, open etc the document. Then read the two ranges (not cells) into an array then loop through the doc comparing every word to the array. Then replace with the corresponding hyperlink in the second array. I think that is what I would do.

That has to be more efficient than looping through the document multiple times. Let me have a look a bit later, I have something pretty similar so i can probably steal a load of the code to make it a bit easier.

Sounds like what i want

ideally be able to just point it at an excel format (via the open dialogue) with the format as per here (though without the VBA column obviously

)

http://s000.tinyupload.com/?file_id=37169605464810461665

Vince · 6 Jun 2019 at 01:47

rG-tom said:
Sounds like what i want ideally be able to just point it at an excel format (via the open dialogue) with the format as per here (though without the VBA column obviously )

http://s000.tinyupload.com/?file_id=37169605464810461665

Got a bit carried away doing other stuff but this works:

Code:

Sub ReplaceLinks()

Dim myexcel As Object
Dim myWB As Object
Set myexcel = CreateObject("Excel.Application")
Set myWB = myexcel.Workbooks.Open("C:\users\vince\desktop\WordHyperLinkTest2.xlsx")
Dim NameIndex As Variant
NameIndex = myWB.Sheets("Data").Range("Names").Value
LinkIndex = myWB.Sheets("Data").Range("Links").Value

Dim wd As Range
Dim itemName As String
Dim wordName As String
Dim linkName As String
Dim lineCount As Integer
indexCount = 1
lineCount = 1
 Do While lineCount < 4  'Set as number of lines in excel spreadsheet.
      For Each wd In ActiveDocument.Words
            wordName = wd
            itemName = (NameIndex(indexCount, 1))
            linkName = (LinkIndex(indexCount, 1))
            itemName = RemoveWhiteSpace(itemName)
            wordName = RemoveWhiteSpace(wordName)
            If StrComp(wordName, itemName) = 0 Then
            With Selection.Words
              ActiveDocument.Hyperlinks.Add Anchor:=wd, Address:=linkName
            End With
            End If
            Next wd
      lineCount = lineCount + 1
      indexCount = indexCount + 1
    Loop
 
myWB.Close False
Set myexcel = Nothing
Set myWB = Nothing

End Sub

Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

There are a few things you will need to do, first add the reference to regular expression 5.5:

Then you will need to set the two ranges in the code in the spreadsheet. Finally set the value at the number of lines in your excel spreadsheet. (you could just check the size of the range here but its late and im being lazy). Oh and also save that as an xlsx.

I tested it using your spreadsheet and a document with a few words in it:

You could also slim out the multiple increments as they are not nessesary and declare the variant i forgot to but to be honest it works so just have a play with it. If you want the test files let me know.

Oh and I know I said just loop through once and compare to the whole array would be more efficient but I couldn't get my head around it quite as easily so this is what you get :cool:

rG-tom · 6 Jun 2019 at 11:23

Thanks, really appreciated!

I will try this now...does it work with footnotes/footers etc or just main body text? That was the big "must have" missing from my own code, it only worked on main body.

Vince · 6 Jun 2019 at 12:00

rG-tom said:
Thanks, really appreciated!

I will try this now...does it work with footnotes/footers etc or just main body text? That was the big "must have" missing from my own code, it only worked on main body.

Should work with everything - Let me know if not and ill adapt it

Just looking at the object model it should be really easy to check the headers and footers and include them in the loop if the word loop doesn't capture header and footer objects. I used the word object model which i believe should also cover these document sections:

https://docs.microsoft.com/en-us/office/vba/api/word.headersfooters

Call me sad but I enjoyed spending 45 mins confusing myself

If I wasn't as tired as I was I probably would have noticed much sooner that the word object model loves to put white space before and after the words so my vbcompare wasn't working as it should, hence the regular expression to trim white space.

rG-tom · 6 Jun 2019 at 13:25

Hey, got it working for body text (inc replacing the row count with some code check the last cell in range), but it doesn't change footnotes i'm afraid. If it helps, 99% of the links i need to add are actually in footnotes, so it wouldn't be the end of the world if this ONLY looked at footnotes (and would probably make it more efficient?).

Vince · 6 Jun 2019 at 13:34

rG-tom said:
Hey, got it working for body text (inc replacing the row count with some code check the last cell in range), but it doesn't change footnotes i'm afraid. If it helps, 99% of the links i need to add are actually in footnotes, so it wouldn't be the end of the world if this ONLY looked at footnotes (and would probably make it more efficient?).

Let me add the foot notes into the code. Might need a little bit as I have a dude just arrived to sort out some of my AV.

rG-tom · 6 Jun 2019 at 14:57

Vince said:
Let me add the foot notes into the code. Might need a little bit as I have a dude just arrived to sort out some of my AV.

Cheers!

Just thinking about practical use of this and have changed a few things such as adding an open dialogue to choose where the xlsx file is kept:

Code:

Sub ReplaceLinks()

Dim sTXT As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Excel file with data"
        .InitialFileName = Options.DefaultFilePath(wdDocumentsPath)
        .Filters.Clear
 
        .ButtonName = "Select"
        If .Show = -1 Then 'if OK is pressed
            sTXT = .SelectedItems(1)
    

Dim myexcel As Object
Dim myWB As Object
Set myexcel = CreateObject("Excel.Application")
'Set myWB = myexcel.Workbooks.Open(ActiveDocument.Path & "\WordHyperlinkTest1.xlsx")
Set myWB = myexcel.Workbooks.Open(sTXT)
Dim NameIndex As Variant
NameIndex = myWB.Sheets("Data").Range("Names").Value
LinkIndex = myWB.Sheets("Data").Range("Links").Value
Dim lRow As Variant
     'Find the last non-blank cell in column A(1)
    lRow = myWB.Sheets("Data").Range("Names").Rows.Count + 1

Dim wd As Range
Dim itemName As String
Dim wordName As String
Dim linkName As String
Dim lineCount As Integer
indexCount = 1
lineCount = 1
 Do While lineCount < lRow  'Set as number of lines in excel spreadsheet.
      For Each wd In ActiveDocument.Words
            wordName = wd
            itemName = (NameIndex(indexCount, 1))
            linkName = (LinkIndex(indexCount, 1))
            itemName = RemoveWhiteSpace(itemName)
            wordName = RemoveWhiteSpace(wordName)
            If StrComp(wordName, itemName) = 0 Then
            With Selection.Words
              ActiveDocument.Hyperlinks.Add Anchor:=wd, Address:=linkName
            End With
            End If
            Next wd
      lineCount = lineCount + 1
      indexCount = indexCount + 1
    Loop
 
myWB.Close False
Set myexcel = Nothing
Set myWB = Nothing
   Else
            MsgBox ("Cancelled by user")



End If
End With
End Sub

Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

Whilst doing this, I started thinking it might actually be way better if this was structured exactly the opposite way...rather than having a macro inside a word file that calls a list from excel, how much work would it be to do the exact opposite, IE have the code inside an excel file that you then point at the word document?

Would this need a complete re-write, or could it be switched around reasonably easily? Sorry for ridiculous scope change, I don't know why I hadn't thought of it this way around as it's the excel file that needs to be specific format where as you should be able to offer this up to any word doc and it should work!

Vince · 6 Jun 2019 at 15:29

rG-tom said:

Cheers!

Just thinking about practical use of this and have changed a few things such as adding an open dialogue to choose where the xlsx file is kept:

Code:

Sub ReplaceLinks()

Dim sTXT As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Excel file with data"
        .InitialFileName = Options.DefaultFilePath(wdDocumentsPath)
        .Filters.Clear
 
        .ButtonName = "Select"
        If .Show = -1 Then 'if OK is pressed
            sTXT = .SelectedItems(1)
   

Dim myexcel As Object
Dim myWB As Object
Set myexcel = CreateObject("Excel.Application")
'Set myWB = myexcel.Workbooks.Open(ActiveDocument.Path & "\WordHyperlinkTest1.xlsx")
Set myWB = myexcel.Workbooks.Open(sTXT)
Dim NameIndex As Variant
NameIndex = myWB.Sheets("Data").Range("Names").Value
LinkIndex = myWB.Sheets("Data").Range("Links").Value
Dim lRow As Variant
     'Find the last non-blank cell in column A(1)
    lRow = myWB.Sheets("Data").Range("Names").Rows.Count + 1

Dim wd As Range
Dim itemName As String
Dim wordName As String
Dim linkName As String
Dim lineCount As Integer
indexCount = 1
lineCount = 1
 Do While lineCount < lRow  'Set as number of lines in excel spreadsheet.
      For Each wd In ActiveDocument.Words
            wordName = wd
            itemName = (NameIndex(indexCount, 1))
            linkName = (LinkIndex(indexCount, 1))
            itemName = RemoveWhiteSpace(itemName)
            wordName = RemoveWhiteSpace(wordName)
            If StrComp(wordName, itemName) = 0 Then
            With Selection.Words
              ActiveDocument.Hyperlinks.Add Anchor:=wd, Address:=linkName
            End With
            End If
            Next wd
      lineCount = lineCount + 1
      indexCount = indexCount + 1
    Loop
 
myWB.Close False
Set myexcel = Nothing
Set myWB = Nothing
   Else
            MsgBox ("Cancelled by user")



End If
End With
End Sub

Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

Whilst doing this, I started thinking it might actually be way better if this was structured exactly the opposite way...rather than having a macro inside a word file that calls a list from excel, how much work would it be to do the exact opposite, IE have the code inside an excel file that you then point at the word document?

Would this need a complete re-write, or could it be switched around reasonably easily? Sorry for ridiculous scope change, I don't know why I hadn't thought of it this way around as it's the excel file that needs to be specific format where as you should be able to offer this up to any word doc and it should work!

I'll have a look, shouldn't be much different to be honest. Just as you say the other way around. Not sure on the functionality referencing word from excel but I guess we both might find out. When this engineer leaves I'll have a little look.

rG-tom · 6 Jun 2019 at 16:31

Vince said:
I'll have a look, shouldn't be much different to be honest. Just as you say the other way around. Not sure on the functionality referencing word from excel but I guess we both might find out. When this engineer leaves I'll have a little look.

Cheers! Getting it working on footnotes is a higher priority for me, and I'm not really getting anywhere with it

Vince · 6 Jun 2019 at 18:47

I made it work on the train on the way home

I do need to add it into the code properly though. Ill have a little play! Also doing it the other way is also viable.

Vince · 7 Jun 2019 at 00:32

rG-tom said:
Cheers! Getting it working on footnotes is a higher priority for me, and I'm not really getting anywhere with it

Right so that was much harder than I anticipated. But I managed to make it all work, only downside is that it is an extension of my original code. This code will work on footnotes, endnotes and main body text. it's not uber efficient and needs some tweaking in a few places but i've done pretty much all the major bug finding, there are a couple of cheeky ones left in there I am sure. I noticed for example that occasionally if you leave your cursor focus in the endnote or footnote while running the code that it can throw a bit of a wobblie so setting cursor focus in code might be a plan, also if you run the code twice on the same document it seems to somehow double up on hyperlinks? Might need to build a quick check in there to see if a link already exists... There are also some efficiency gains to be had / Mistakes to be corrected in this I am sure! It works though.

Remember yesterday when I said there were better ways? I think the method used for footnotes and endnotes might be a little bit closer to that much better way. you can also port the majority of the code to vba in excel if you fancy a bit of a challenge. In terms of practical use you can port this code into visual studio as a package alongside ribbon changes and force deployment every time somebody starts word, we deploy packages in this way to outlook and word all the time to deploy similar functionality to this to our userbase

end result the people that write the documents finish, click the button, give it a quick check, save it into the dms and away they go. Mind you I do see how doing it the other way could mean you could just potentially be equally or even more beneficial. Anyway ill stop waffling:

Code:

Sub ReplaceLinks()

Dim myexcel As Object
Dim myWB As Object
Set myexcel = CreateObject("Excel.Application")
Set myWB = myexcel.Workbooks.Open("C:\users\vince\desktop\WordHyperLinkTest2.xlsx")
Dim NameIndex As Variant
NameIndex = myWB.Sheets("Data").Range("Names").Value
LinkIndex = myWB.Sheets("Data").Range("Links").Value

Dim wd As Range
Dim itemName As String
Dim wordName As String
Dim linkName As String
Dim bmkNumber As Integer
Dim bmkCount As Integer
Dim lineCount As Integer
Dim bmkIndex As Integer
Dim ftnIndex As Integer
Dim ftnNumber As Integer
Dim ftnCount As Integer
Dim loopCount As Integer
Dim ftnloopCount As Integer
Dim wordCount As Integer
Dim ftnwordCount As Integer
Dim bmkText As String
Dim ftnText As String
Dim fnword As String
Dim ftnfnWord As String
Dim Result() As String

indexCount = 1
lineCount = 1
' Loop through the main body
 Do While lineCount < 4  'Set as number of lines in excel spreadsheet.
      For Each wd In ActiveDocument.Words
            wordName = wd
            itemName = (NameIndex(indexCount, 1))
            linkName = (LinkIndex(indexCount, 1))
            itemName = RemoveWhiteSpace(itemName)
            wordName = RemoveWhiteSpace(wordName)
            If StrComp(wordName, itemName) = 0 Then
            With Selection.Words
              ActiveDocument.Hyperlinks.Add Anchor:=wd, Address:=linkName
            End With
            End If
            Next wd
      lineCount = lineCount + 1
      indexCount = indexCount + 1
    Loop
 
      bmkNumber = ActiveDocument.Endnotes.Count
      bmkCount = 0
    Do While bmkCount < bmkNumber
      For Each bmk In ActiveDocument.Endnotes
            bmkIndex = bmk.Index
            bmkText = ActiveDocument.Endnotes(bmkIndex).Range.Text
            Result = Split(bmkText)
            wordCount = UBound(Result()) + 2
            loopCount = 1
             Do While loopCount < wordCount
              itemName = (NameIndex(loopCount, 1))
              linkName = (LinkIndex(loopCount, 1))
              itemName = RemoveWhiteSpace(itemName)
              fnword = ActiveDocument.Endnotes(bmkIndex).Range.Words(loopCount).Text
              fnword = RemoveWhiteSpace(fnword)
               If StrComp(fnword, itemName) = 0 Then
                With Selection.Endnotes
                ActiveDocument.Hyperlinks.Add Anchor:=ActiveDocument.Endnotes(bmkIndex).Range.Words(loopCount), Address:=linkName
                End With
              loopCount = loopCount + 1
            End If
            Loop
            Next bmk
      bmkCount = bmkCount + 1
    Loop
 
      ftnNumber = ActiveDocument.Footnotes.Count
      ftnCount = 0
    Do While ftnCount < ftnNumber
      For Each ftn In ActiveDocument.Footnotes
            ftnIndex = ftn.Index
            ftnText = ActiveDocument.Footnotes(ftnIndex).Range.Text
            Result = Split(ftnText)
            ftnwordCount = UBound(Result()) + 2
            ftnloopCount = 1
             Do While ftnloopCount < ftnwordCount
              itemName = (NameIndex(ftnloopCount, 1))
              linkName = (LinkIndex(ftnloopCount, 1))
              itemName = RemoveWhiteSpace(itemName)
              ftnfnWord = ActiveDocument.Footnotes(ftnIndex).Range.Words(ftnloopCount).Text
              ftnfnWord = RemoveWhiteSpace(ftnfnWord)
               If StrComp(ftnfnWord, itemName) = 0 Then
                With Selection.Footnotes
                ActiveDocument.Hyperlinks.Add Anchor:=ActiveDocument.Footnotes(ftnIndex).Range.Words(ftnloopCount), Address:=linkName
                End With
              ftnloopCount = ftnloopCount + 1
            End If
            Loop
            Next ftn
      ftnCount = ftnCount + 1
    Loop
 
myWB.Close True
Set myexcel = Nothing
Set myWB = Nothing

End Sub

Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

bledd · 7 Jun 2019 at 10:57

Great response @Vince