How to import data from multiple pages? - vba

Question

I have a small piece of code that lists links in a site.
Sub ListLinks()
'Set a reference to microsoft Internet Controls
Dim IeApp As InternetExplorer
Dim sURL As String
Dim IeDoc As Object
Dim i As Long
Set IeApp = New InternetExplorer
IeApp.Visible = True
sURL = "http://www.sharenet.co.za/v3/q_sharelookup.php"
IeApp.Navigate sURL
Do
Loop Until IeApp.ReadyState = READYSTATE_COMPLETE
Set IeDoc = IeApp.Document
For i = 0 To IeDoc.Links.Length - 1
Cells(i + 1, 1).Value = IeDoc.Links(i).href
Next i
Set IeApp = Nothing
End Sub
That is very useful for listing all links in a site. How can I loop through these URLs and import data from each one?
For instance, the first link under 'Name or Sector' is this:
http://www.sharenet.co.za/v3/sharesfound.php?ssector=0533&exch=JSE&bookmark=Oil & Gas&scheme=default
There is actually nothing to import from there. The next link has some data:
http://www.sharenet.co.za/v3/sharesfound.php?ssector=0537&exch=JSE&bookmark=Oil%20-%20Integrated&scheme=default
The data from there looks like this:
Name Full Name Code Sector
SACOIL-N Sacoil Holdings Ltd NPL SCLN 0537
ERIN Erin Energy Corporation ERN 0537
BEE-SASOL BEE - SASOL LIMITED SOLBE1 0537
SACOIL SACOIL HOLDINGS LD SCL 0537
OANDO OANDO PLC OAO 0537
OANDORIGT OANDO PLC RIGT OAON 0537
MONTAUK Montauk Holdings Ltd MNK 0537
How can I import that data from each link?

Answer 1

This seems to work pretty well. It may need a bit of fine tuning, but this should be pretty darn close.
Sub ListLinks()
'Set a reference to microsoft Internet Controls
Dim IeApp As InternetExplorer
Dim sURL As String
Dim IeDoc As Object
Dim i As Long
Set IeApp = New InternetExplorer
IeApp.Visible = True
sURL = "http://www.sharenet.co.za/v3/q_sharelookup.php"
IeApp.Navigate sURL
Do
Loop Until IeApp.ReadyState = READYSTATE_COMPLETE
Set IeDoc = IeApp.Document
For i = 0 To IeDoc.Links.Length - 1
Cells(i + 1, 1).Value = IeDoc.Links(i).href
Next i
Set IeApp = Nothing
Call CopyFromURL
End Sub
Public Sub CopyFromURL()
Dim IE As InternetExplorer, doc As HTMLDocument
Dim thisClass As IHTMLElement2, thisLink As IHTMLElement
Dim rng As Range, cell As Range
Const READYSTATE_COMPLETE As Integer = 4
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long
row = 1
Set rng = Range("A1:A5")
For Each cell In rng
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate cell
Do While (IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
Set TR_col = IE.Document.getElementsByTagName("TR")
For Each TR In TR_col
Set TD_col = TR.getElementsByTagName("TD")
col = 2
For Each TD In TD_col
Cells(row, col) = TD.innerText
col = col + 1
Next
col = 2
row = row + 1
Next
Next cell
IE.Quit
End Sub