vbams-wordhyperlink

Trying to append hyperlinks (to bookmarks) given a selection in Word


I've got a selection of text highlighted that I want to convert into links (to already created bookmarks that conform to a pattern) in MS Word (Mac if it matters). Right now I'm just trying to append a list of all the links to the end of the selection.

The culprit code seems to be related to this loop:

' Append hyperlinks to the end of the selection
    If mappingCount > 0 Then
        ' Move cursor to the end of the selection
        Set rng = sel.Range
        rng.Collapse wdCollapseEnd
        
        ' Insert a line break, prompt, and space
        rng.InsertAfter vbCr
        rng.InsertAfter prompt
        rng.InsertAfter " "
        rng.Collapse wdCollapseEnd
        
        ' Iterate through the mappings array to append hyperlinks for each tuple
        For k = 0 To mappingCount - 1
            ' Insert the link text
            rng.InsertAfter mappings(k)(0)
            ' Create hyperlink using the inserted text
            doc.Hyperlinks.Add Anchor:=rng, _
                Address:="", _
                SubAddress:=mappings(k)(1), _
                TextToDisplay:=mappings(k)(0)
            ' Move range to the end of the inserted hyperlink
            rng.Collapse wdCollapseEnd
            ' Add ; and space if not the last item
            If k < mappingCount - 1 Then
                rng.InsertAfter "; "
                rng.Collapse wdCollapseEnd
            End If
        Next k
    End If

What is happening is that the doc.Hyperlinks.Add is somehow mucking with the range so it's overwriting each hyperlink instead of adding them (concatenating them). If I comment out the doc.Hyperlinks.Add line the code correctly outputs the anchor text for all of the links properly concatenated.

If the doc.Hyperlinks.add is uncommented, it appends the Prompt: to the selection and the very last hyperlink only, even if mappings array has many elements.

Any idea why the doc.Hyperlinks.Add causes the range computations to get all screwed up? thx.

I've tried 10 different ways of concatenating the links, this is the closest to working (as it works without the actual hyperlinks being created).

the mappings array contains the link display text (anchor text) in mappings(k)(0) and the bookmark name in mappings(k)(1)


Solution

  • Following on from my comment above about resetting rng using the inserted Hyperlink object:

    (note my hyperlinks are not to bookmarks, so you'll need to make that adjustment)

    Sub tester()
        
        Dim mappings, sel, mappingCount As Long, k As Long
        Dim prompt As String, lnk As Hyperlink, rng As Range
        Dim doc As Document, mapping
        
        mappings = Array(Array("Google", "https://www.google.com"), _
                            Array("Yahoo", "https://www.yahoo.com"), _
                            Array("Bing", "https://www.bing.com"))
        
        mappingCount = 3
        prompt = ">> "
        
        Set doc = ActiveDocument
        Set sel = Selection
    
        ' Append hyperlinks to the end of the selection
        If mappingCount > 0 Then
            ' Move cursor to the end of the selection
            Set rng = sel.Range
            rng.Collapse wdCollapseEnd
            
            ' Insert a line break, prompt, and space
            rng.InsertAfter vbCr & prompt & " "
            rng.Collapse wdCollapseEnd
            
            ' Iterate through the mappings array to append hyperlinks for each tuple
            For k = 0 To mappingCount - 1
                Set lnk = doc.Hyperlinks.Add(Anchor:=rng, _
                            Address:=mappings(k)(1), _
                            SubAddress:="", _
                            TextToDisplay:=mappings(k)(0))
                Set rng = lnk.Range         '<<<<<< reset `rng`
                rng.Collapse wdCollapseEnd
                
                ' Add ; and space if not the last item
                If k < mappingCount - 1 Then
                    rng.InsertAfter "; "
                    rng.Collapse wdCollapseEnd
                End If
            Next k
        End If
    
    End Sub