Word – Converting All Plain Text Links to Hyperlinks

microsoft wordmicrosoft-officevba

I have a rather large Word file (+1,100 pages) that contains plain text links of media coverage. For instance, the Word document contains:

The News Leader (AP) Va. police officer who died on her first shift laid to rest
http://www.newsleader.com/story/news/nation-now/2016/03/01/va-police-officer-who-died-her-first-shift-laid-rest/81183272/
03.01.16

Livingston Daily Va. police officer who died on her first shift laid to rest
http://www.livingstondaily.com/story/news/nation-now/2016/03/01/va-police-officer-who-died-her-first-shift-laid-rest/81183272/
03.01.16

(In the Word document, these links are not hyperlinks, just text!)

Currently, the way we acquire the data and merge into Word formats the links as plain text rather than hyperlinks.

I'd like to use VBA to convert all these plain text links into clickable hyperlinks, preserving the link text (e.g., hyperlinks with the anchor text of the link remaining).

I've found examples of code to find and replace specific strings with specific links, for instance:

Sub FindAndHyperlink()
    'define the style
    Dim strStyle As String
    strStyle = "Normal"
    'set the search range
    Dim rngSearch As Range
    Set rngSearch = ActiveDocument.Range
    'set the search string
    Dim strSearch As String
    strSearch = "tuesday"
    'set the target address for the hyperlink
    Dim strAddress As String
    strAddress = "http:\\google.com"

    With rngSearch.Find
        Do While .Execute(findText:=strSearch, MatchWholeWord:=True, Forward:=True) = True
            With rngSearch 'we will work with what is found as it will be the selection
                ActiveDocument.Hyperlinks.Add Anchor:=rngSearch, Address:=strAddress
                .Style = ActiveDocument.Styles(strStyle) 'throw the style on it after the link
            End With
            rngSearch.Collapse Direction:=wdCollapseEnd
            'keep it moving
        Loop
    End With
End Sub

But, I can't figure out how to dynamically change the search / select / replace functions.

What I'd like:

  1. Search for "http"
  2. Select entire hyperlink
  3. Make into a hyperlink, not changing the anchor text
  4. Repeat for all instances of plain text hyperlinks

Any suggestions?

Best Answer

Try this:

Sub Hyperlinker()

    Dim Rng As Range

    Set Rng = ActiveDocument.Range
    With Rng.Find
        Do While .Execute(findText:="http:", Forward:=False) = True
            Rng.MoveEndUntil (" ")
            ActiveDocument.Hyperlinks.Add _
                Anchor:=Rng, _
                Address:=Rng.Text, _
                SubAddress:="", _
                ScreenTip:="", _
                TextToDisplay:=Rng.Text
            Rng.Collapse wdCollapseStart
        Loop
    End With

End Sub

After it's done replacing them all, you may have to save and reopen the Word document to have the links start functioning.

Related Question