Sub USPTOAbstHTML1()
Application.ScreenUpdating = False
Dim Rng As Range, Tbl As table, StrTxt As String, HttpReq As Object, i As Long, doc As MSHTML.HTMLDocument
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
Set oHtml = New HTMLDocument
With ActiveDocument.Range
    For Each Tbl In .Tables
        With Tbl
            For i = 1 To .Rows.Count
                With .Cell(i, 2).Range
                    With .Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "US [0-9],[0-9]{3},[0-9]{3}"
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindStop
                        .Format = False
                        .MatchWildcards = True
                        .Execute
                    End With
                        If .Find.Found Then
                            If .Hyperlinks.Count > 0 Then
                                HttpReq.Open "GET", .Hyperlinks(1).Name, False
                                HttpReq.send
                                oHtml.body.innerHTML = HttpReq.responseText
                                StrTxt = oHtml.getElementsByTagName("p")(0).innerText
                            End If
                        End If
                            .Collapse wdCollapseEnd
                            .Find.Execute
                End With
                With .Cell(i, 3).Range
                .InsertAfter vbCr & "Abstract:" & StrTxt
                End With
            Next
        End With
    Next
End With
Set HttpReq = Nothing
Application.ScreenUpdating = True
End Sub