Sub ReplaceHTMLLinks()
Dim oRng As Range
Dim sLink As String
Dim sAddr As String
Dim sDisplay As String
Dim vLink As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(FindText:="\<a href=*\<\/a\>", MatchWildcards:=True)
            sLink = oRng.Text
            vLink = Split(sLink, Chr(34))
            sAddr = vLink(1)
            sDisplay = Replace(Mid(sLink, InStr(1, sLink, ">") + 2), " </a>", "")
            oRng.Text = ""
            oRng.Hyperlinks.Add Anchor:=oRng, _
                                Address:=sAddr, _
                                TextToDisplay:=sDisplay
            oRng.Collapse 0
        Loop
    End With
End Sub