여러 페이지에서 데이터를 가져 오는 방법은 무엇입니까?

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 & 가스 & 체계 = 기본

: 예를 들어

은 '이름 또는 부문'에서 첫 번째 링크는 이것이다. 이 같은이 모습에서 http://www.sharenet.co.za/v3/sharesfound.php?ssector=0537&exch=JSE&bookmark=Oil%20-%20Integrated&scheme=default

데이터 : 다음 링크는 일부 데이터가

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 

어떻게 가져올 수 있습니다 각 링크에서 데이터인가?

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