![]() |
|
|
|
#1
|
||||
|
||||
|
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. |
|
#2
|
||||
|
||||
|
It would have been helpful had you advised that beforehand. Try:
Code:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
||||
|
||||
|
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. |
|
#4
|
||||
|
||||
|
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 Code:
"https://mirror.patentscope.wipo.int/patentscope/docservicepdf_pct_mirror/*.pdf" |
|
#5
|
||||
|
||||
|
As this has answered my original question, Can be marked as solved, as the code does the job.
|
|
#6
|
||||
|
||||
|
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.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
| Tags |
| word vba |
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Multiple Hyperlink to a single string | PRA007 | Word VBA | 7 | 11-09-2015 04:29 PM |
find a set of characters in a string and return a 0 (zero) if not found
|
MaineLady | Excel | 2 | 11-05-2015 03:23 PM |
Why is this Find string not working
|
TechEd | Word VBA | 5 | 07-05-2014 08:12 PM |
Find and replace a string of text
|
errtu | Word | 1 | 01-31-2013 02:09 PM |
Bad view when using Find and Find & Replace - Word places found string on top line
|
paulkaye | Word | 4 | 12-06-2011 11:05 PM |