Find whether string contains hyperlink and Process the same

[PRA007]

As part of long process, I want to find following string:

EP [0-9]{5,} [0-9A-Z]{1,2}

and if it contains hyperlink i would like to use that link to process it for winhttp request like this.
if in doc, there is
EP 2614045 B1 with hyperlink https://data.epo.org/publication-ser...45&ki=B1&lg=en

Sub EPHYPERLINKDOWN()
Dim myURL As String, s As String, s1 As String, StrTxt As String
myURL = "https://data.epo.org/publication-server/document?cc=EP&pn=2614045&ki=B1&lg=en"

Dim HttpReq As Object, oStrm As Object
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

I want to remove original hyperlink with MsgBox Hyperlink.

So, I learned middle part but don't know how to run first part and last one.

[macropod]

Originally Posted by PRA007

As part of long process, I want to find following string:

EP [0-9]{5,} [0-9A-Z]{1,2}

and if it contains hyperlink i would like to use that link to process it

Unless 'EP 2614045 B1' is how the hyperlink is displayed in the document, your Find will not locate it. If the hyperlink looks like to one in your post, your Find will not locate that either, because there are other characters interspersed with them in the hyperlink (e.g. EP&pn=2614045&ki=B1). If you want to find strings like 'EP' and '2614045' and 'B1' in such a hyperlink, you'd need to use a Find expression like:
EP[!0-9]@[0-9]{7}[!0-9]@B1
Even then, all you'll have found is the part of the hyperlink containing EP 2614045 B1 - not the whole hyperlink.

As for your actual Find expression, that doesn't seem to have anything to do with the hyperlink you say you want to find, so I can't really understand what you're trying to do.

You also say you want to:

remove original hyperlink with MsgBox Hyperlink

but you can't do that by inserting the text the message box displays - you need to actually create a hyperlink.

[PRA007]

Please let me make it clearer.

I have in my document already hyperlinked numbers.

One being EP 2614045 B1 having hyperlink https://data.epo.org/publication-ser...45&ki=B1&lg=en

There are also other numbers with hyperlinks.

I just want to search for EP number.
If EP number have already hyperlink then I want to use that hyperlink in my winhttp request.

winhttp request will give me one other hyperlink.

I want to use that hyperlink to insert hyperlink to that EP number in place of original Hyperlink.

[macropod]

Perhaps you could attach a document to a post showing exactly how the content is displayed in it, plus what it is you want to do with that content. As I said, the hyperlinks you have posted cannot be found via the "EP [0-9]{5,} [0-9A-Z]{1,2}" wildcard expression.

[PRA007]

I think I am not good at explaining. That paid off. allowed me to try on my own. I found bit of solution by browsing my earlier Ques.
I recorded macro and then used solution from post to yield following solution.

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

I think there is problem with loop in second part. Please suggest
Its not looping through all instances
Other problem with this code here is that I want to remove original hyperlink with what I get here as s1 at last (I use msgbox to see weather code is working or not).

file

[macropod]

Try:

Sub EPHYPERLINKDOWN()
Application.ScreenUpdating = False
Dim StrTxt As String, HttpReq As Object, i As Long
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "EP [0-9]{5,} [0-9A-Z]{1,2}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Hyperlinks.Count > 0 Then
      HttpReq.Open "GET", .Hyperlinks(1).Name, False
      HttpReq.Send
      StrTxt = HttpReq.ResponseText
      i = InStr(StrTxt, "https://data.epo.org/publication-server/pdf-document")
      StrTxt = Mid(StrTxt, i, Len(StrTxt) - i)
      i = InStr(InStr(StrTxt, ".pdf") + 3, StrTxt, ".pdf")
      StrTxt = Replace(Left(StrTxt, i + 3), "amp;", "")
      .Hyperlinks(1).Address = StrTxt
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Set HttpReq = Nothing
Application.ScreenUpdating = True
End Sub

[PRA007]

Code was working fine till yesterday, but european patent office have changed their website overnight.

I will have to study the website now for the change have have made.

[macropod]

Originally Posted by PRA007

Please note that some of my EP Links doesn't contain pdf doc.

It would have been helpful had you advised that beforehand. Try:

Sub EPHYPERLINKDOWN()
Application.ScreenUpdating = False
Dim StrTxt As String, HttpReq As Object, i As Long
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "EP [0-9]{5,} [0-9A-Z]{1,2}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Hyperlinks.Count > 0 Then
      HttpReq.Open "GET", .Hyperlinks(1).Name, False
      HttpReq.Send
      StrTxt = HttpReq.ResponseText
      i = InStr(StrTxt, "https://data.epo.org/publication-server/pdf-document")
      If i > 0 Then
        StrTxt = Mid(StrTxt, i, Len(StrTxt) - i)
        i = InStr(InStr(StrTxt, ".pdf") + 3, StrTxt, ".pdf")
        If i > 0 Then
          StrTxt = Replace(Left(StrTxt, i + 3), "amp;", "")
          .Hyperlinks(1).Address = StrTxt
        End If
      End If
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Set HttpReq = Nothing
Application.ScreenUpdating = True
End Sub

[PRA007]

I will take care from next time.
Whenever I see opportunity of automation, I get excited and ask desperately, and forget to mention the conditions in fully.

As I have edited the post, You can now see what had happened with me.
EOP have changed the website
core of the website still works. I now need to generate hyperlink by my self from found text. I will update Accordingly.

I think with this code will solve my problem.

[PRA007]

One last Question in this thread.

I want to extract link similarly from following website.

view-source:https://patentscope.wipo.int/search/...b=PCTDocuments

Text I want is in following formate

"https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/id00000031470708/PAMPH/WO2015177801.pdf"

I can find it using

"https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/*.pdf"

[PRA007]

As this has answered my original question, Can be marked as solved, as the code does the job.

[macropod]

Originally Posted by PRA007

As I have edited the post, You can now see what had happened with me.
EOP have changed the website

Please don't do that - changing posts that way after they've been replied to destroys the flow of the conversation in the thread. My reply to that post now doesn't make sense.

[macropod]

Originally Posted by PRA007

I want to extract link similarly from following website.

view-source:https://patentscope.wipo.int/search/en/detail.jsf?docId=WO2015177801&recNum=1&tab=PCTDocu ments

Text I want is in following formate

"https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/id00000031470708/PAMPH/WO2015177801.pdf"

I can find it using

"https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/*.pdf"

You would need to use a similar approach to the macro I gave you in post #8.

[PRA007]

Don't know how but this works. If you can just give hint what this does, it would be grateful.

StrTxt = HttpReq.responseText
      i = InStr(StrTxt, "https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/")
      If i > 0 Then
        StrTxt = Mid(StrTxt, i, Len(StrTxt) - i)
        i = InStr(StrTxt, ".pdf")
        If i > 0 Then
         StrTxt = Left(StrTxt, i + 3)

[macropod]

You could find out what these functions do by selecting them and pressing F1 in the VBA help. For example:
• The InStr function returns the starting position of one string within another.
Since StrTxt holds the string returned by HttpReq.ResponseText:
InStr(StrTxt, https://mirror.patentscope.wipo.int/...df_pct_mirror/)
tells us where in that text the string 'https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/' begins. That value is stored as a number in the variable 'i'. If 'i' = 0, the text wasn't found.
• The Mid function retrieves the part of a string beginning between one location and another.
Thus, StrTxt = Mid(StrTxt, i, Len(StrTxt) - i) keeps just that part of StrTxt that begins at position 'i' (the number returned by InStr) in StrTxt to the end of that string.