Sub DownPDFFromHLnk()
Application.ScreenUpdating = False
Dim StrTxt As String, HttpReq As Object
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
With ActiveDocument.Range
    With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[A-Z]{2} [0-9,]{5,}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .Execute
    End With
        Do While .Find.Found
            If .Hyperlinks.Count > 0 Then
                f = ActiveDocument.Path & Application.PathSeparator & .Text & ".pdf"
                HttpReq.Open "GET", .Hyperlinks(1).Name, False
                HttpReq.send
                    If HttpReq.Status = 200 Then
                        Set oStream = CreateObject("ADODB.Stream")
                        oStream.Open
                        oStream.Type = 1
                        oStream.Write HttpReq.responseBody
                        oStream.SaveToFile f, 2
                        oStream.Close
                        .Hyperlinks(1).Address = f
                    End If
            End If
        .Collapse wdCollapseEnd
        .Find.Execute
        Loop
End With
End Sub