Microsoft Office Forums - View Single Post - Macro how to add hyperlink to text in document

slaycock · 10-09-2017, 02:38 AM

The following code will replace the text specified with hyperlinks.

Code:

Option Explicit

Sub insert_authority_hyperlinks()

    Const AUTHORITY_PLACEHOLDER             As String = "<authority>"
    Const PATH_TO_REFERENCES                As String = "W:\Skydrive\Docs\<authority>.htm#chpt_"
    Const SEARCH_TEXT                       As String = "([\(])(<authority>)(*)([)])"
    
    'adjust the 3 to the number you actually need
    Dim authorities(1 To 3)                 As String
    Dim authority                           As Variant
    Dim rng                                 As Word.Range
    Dim name                                As String
    Dim chapter                             As String
    Dim verses(1 To 2)                      As String
    Dim end_of_rng                          As Long
    
    authorities(1) = "John"
    authorities(2) = "Matthew"
    authorities(3) = "Mark"
    ' etc
    
    For Each authority In authorities
        Set rng = ActiveDocument.StoryRanges(wdMainTextStory)
        Do
            With rng.Find
                .Text = Replace(SEARCH_TEXT, AUTHORITY_PLACEHOLDER, authority)
                .MatchWildcards = True
                .Forward = True
                .Wrap = wdFindStop
                .Execute
                If .Found Then
                   
                    end_of_rng = rng.End + 1
                    name = Split(rng.Text, " ")(0)
                    name = Replace(name, "(", "")
                    chapter = Split(Split(rng.Text, " ")(1), ":")(0)
                    verses(1) = Split(Split(rng.Text, ":")(1), "-")(0)
                    'Just in case you need the end reference
                    verses(2) = Split(Split(rng.Text, ":")(1), "-")(1)
                    verses(2) = Replace(verses(2), ")", "")
    
                    ActiveDocument.Hyperlinks.Add _
                        Anchor:=rng, _
                        Address:=Replace(PATH_TO_REFERENCES, AUTHORITY_PLACEHOLDER, authority) & chapter & "_" & verses(1), _
                        TextToDisplay:=rng.Text
                        
                    rng.Start = end_of_rng
                    rng.End = ActiveDocument.StoryRanges(wdMainTextStory).End
                    
                End If
            End With
        Loop Until Not rng.Find.Found
     Next
End Sub

The caveats to this code are

1. You may get unwanted spaces in the hyperlink if these are present in the source text. If that's the case then you'd want to add some trim statements where we create the authority, chapter and verses strings.

2. I've actually no idea if the format you provided for a hyperlink is valid.

I've tested the above on a word document containing

(John 1:16-20)
(Mark 3:18-33)
(Matthew 9:89-101)
(John 1:16-20)
(Mark 3:18-33)
(Matthew 9:89-101)
(John 1:16-20)
(Mark 3:18-33)
(Matthew 9:89-101)
(John 1:16-20)
(Mark 3:18-33)
(Matthew 9:89-101)

and the field codes of the hyperlinks created are of the form

{ HYPERLINK "W:\\Skydrive\\Docs\\John.htm#chpt_1_16" }
....
{ HYPERLINK "W:\\Skydrive\\Docs\\Matthew.htm#chpt_9_89" }

But of course on my system the hyperlinks do nothing as the targets don't exist.