複数のページからデータをインポートするにはどうすればよいですか？

Question

サイト内のリンクを一覧表示する小さなコードがあります。

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 

これは、サイト内のすべてのリンクを一覧表示するのに非常に便利です。これらのURLをループして各URLからデータをインポートするにはどうすればよいですか？例えば

、「名前またはセクターの」下の最初のリンクはこれです： http://www.sharenet.co.za/v3/sharesfound.php?ssector=0533&exch=JSE&bookmark=Oil &ガス&スキーム=デフォルト

そこからインポートするものは、実際にはありません。次のリンクは、いくつかのデータを持っている：私は、各リンクからのデータをインポートすることができますことをどのように

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 

： http://www.sharenet.co.za/v3/sharesfound.php?ssector=0537&exch=JSE&bookmark=Oil%20-%20Integrated&scheme=default

そこからのデータは次のようになりますか？

Answer 1

これはかなりうまくいくようです。微調整が必​​要な場合がありますが、これはかなり近いはずです。

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