Sub EPHYPERLINKDOWN()
Dim myURL As String, s As String, s1 As String, StrTxt As String
Dim HttpReq As Object, oStrm As Object
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(FindText:="EP [0-9]{5,} [0-9A-Z]{1,2}", MatchWildcards:=True)
            If Selection.Hyperlinks.Count > 0 Then
            s = Selection.Hyperlinks(1).Name
            End If
        Loop
    End With
MsgBox (s)
myURL = s
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
HttpReq.Open "GET", myURL, False
HttpReq.send

s = HttpReq.responseText
Set HttpReq = Nothing
Set DocNew = Documents.Add
With DocNew
  .Range.Text = s
    With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = True
      .Text = "https://data.epo.org/publication-server/pdf-document*.pdf*.pdf"
      .Replacement.Text = ""
      .Execute
    End With
    s1 = Replace(.Text, "amp;", "")
    End With
    .Close
Set DocNew = Nothing
Application.ScreenUpdating = True
MsgBox (s1)
End With
End Sub