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导入数据？

例如，名称或部门＆＃39;下的第一个链接。这是： http://www.sharenet.co.za/v3/sharesfound.php?ssector=0533&exch=JSE&bookmark=Oil＆amp;气体＆安培;方案=默认

实际上没有什么可以从那里导入。下一个链接有一些数据： 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

如何从多个页面导入数据？

1 个答案: