Macro how to add hyperlink to text in document

slaycock · #1 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.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to embed hyperlink to another document into an ActiveX Control Text Box	kenboy21	Word VBA	3	02-24-2017 09:41 PM
Macro (or something) to run Spell Check within rich text content boxes in lock document	NMBELL	Word	8	12-21-2015 04:09 PM
Moving from hyperlink to hyperlink in a document	Bengt	Word VBA	2	12-21-2015 12:42 AM
Hyperlink: open the document only once, quit & reopen PP, hyperlink doesnt work anymore	quanghuynguyenhua	PowerPoint	0	10-10-2015 06:17 PM
Macro for word to add page break and specific text to end of document	pizzaman1	Word VBA	6	11-14-2014 11:25 PM