Originally Posted by
mdmackillop
I'm just a bit short of time just now.
Malcolm
Well, like you said...low priority... the code below is the best I can do for brute force processing of your data. Since few have responded to this thread, I'm thinking there is no easy web-query or 10 lines of code. Usually, with web-scraping I like to run my scripts independent so I did my best to modify my 17 lines of script code as a sub. I'm sure it can be optimized, but I'd like to think at least I did the DHTML investigations to obtain the correct references. As in my last post, I get a file that imports to Excel [as I attached ion that post] Stan
Sub GetTed()
'Reference MS Internet Controls
Dim IE As InternetExplorer
Set IE = New InternetExplorer
'first naviagte to home page
IE.Visible = True
IE.Navigate "http://ted.europa.eu/"
'Wait until page is loaded. not recommended, probably need to
'exit after 30 seconds, I'd write it as a separate function
Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
'set up a var go which assumes failure for all navigations
go=0
'make sure it's in English - or choose whatever language by
'specifying part of the innertext
For i= 0 To IE.Document.GetElementsByTagName("A").length-1
s= IE.Document.GetElementsByTagName("A").Item(i)
If s.GetAttribute("innerText")<>"" AND Instr(s.InnerText,"Official Journal") Then
s.click()
go=1
Exit For
End If
Next
If go=0 Then
goto end
End If
Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
'Now move to NUTS
go=0
For i= 0 To IE.Document.GetElementsByTagName("A").length-1
s= IE.Document.GetElementsByTagName("A").Item(i)
If s.GetAttribute("innerText")<>"" AND Instr(s.InnerText,"(NUTS)") Then
s.click()
go=1
Exit For
End If
Next
End If
If go=0 Then
goto end
End If
Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
go=0
'this is the tricky part, the next page has links to tables for all countries
'but does not include an innertext to test with, I noticed that GB suddenly becomes
'UK - which is the last in the list and [hoprefully] always -10 from the last
'anchor
n = oIE.Document.GetElementsByTagName("A").length-10
If n>0 Then
oIE.Document.GetElementsByTagName("A").Item(n).click
go=1
Else
goto end
End If
'bring First Table
Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
go=0
cTable = "Ref,Details,Country,Start,End" & vbcrlf
If IE.Document.Body.GetElementsByTagName("TABLE").Item(39)
cTable = cTable & gettable(IE.Document.Body.GetElementsByTagName("TABLE").Item(39).InnerText)
go=1
x=2
'loop through subsequent tables if they exist
While go=1
n=oIE.Document.GetElementsByTagName("A").length-1
For i= 0 To n
If oIE.Document.GetElementsByTagName("A").Item(i) Then
s= oIE.Document.GetElementsByTagName("A").Item(i)
If s.GetAttribute("innerText")<>"" AND s.InnerText=x Then
s.click()
Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
cTable = cTable & gettable(IE.Document.Body.GetElementsByTagName("TABLE").Item(39).InnerText)
x=x+1
Else
go=0
End if
End if
Loop
End If
'at this point you should have a csv memvar which you can outpout to a file or
'position back into a worksheet... your choice
:end
Set IE = Nothing
End Sub
Public Function gettable(c AS String)
cTxt = cTxt=Mid(c,Instr(c,"Deadline",8))
cTxt=Replace(cTxt,",",";")
cTxt=Replace(cTxt," ",",")
cTxt=Replace(cTxt,",,",",")
cTxt=Replace(cTxt,", ",",")
Return cTxt
End Function