Question

我从此页面[http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures]抓取表数据时遇到问题。我使用这段代码，但不抓任何数据：

Public Sub ScrapTableData()
    Dim sURL As String
    Dim XMLHttpRequest As XMLHTTP
    Dim HTMLDoc As New HTMLDocument
    Dim elc As HTMLHtmlElement
    Dim i As Integer

    sURL = "http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures"

    Set XMLHttpRequest = New MSXML2.XMLHTTP
    XMLHttpRequest.Open "GET", sURL, False
    XMLHttpRequest.responseXML.async = False
    XMLHttpRequest.send

    Do While XMLHttpRequest.Status <> 200
        DoEvents
    Loop
    While XMLHttpRequest.ReadyState <> 4
        DoEvents
    Wend

    HTMLDoc.body.innerHTML = XMLHttpRequest.responseText

    ' Tables
    Dim tbl    As HTMLTable, row    As HTMLTableRow, cell   As HTMLTableCell
    i = 1
    For Each tbl In HTMLDoc.getElementsByTagName("table")
       For Each row In tbl.Rows
           For Each cell In row.Cells
               ActiveSheet.Cells(i, 5) = cell.innerText
               i = i + 1
           Next
       Next
    Next
End Sub

我的代码找不到HTML table标记。

此外，如果我使用这部分代码，请不要列出所有HTML标记（例如HTML DIV标记）和描述6个按钮的HTML：

i = 0
Dim elc As HTMLHtmlElement
For Each elc In HTMLDoc.all
    Worksheets("Tables").Range("A1").Offset(i, 0) = elc.tagName
    i = i + 1
Next

6个按钮：年，季，月，......，日

我需要模拟点击它们来显示（刮除）不同表格的数据。

Answer 1

我不认为XMLHTTP方法在这种情况下会起作用，你需要打开IE。以下代码将执行此操作。您可能需要修改循环以将数据放入工作表中，我没有修改它。最后，我还放了一些代码来改变选项卡。希望这有帮助

Sub test()
' open IE, navigate to the website of interest and loop until fully loaded
    Set IE = CreateObject("InternetExplorer.Application")
    my_url = "http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures"

    With IE
        .Visible = True
        .navigate my_url
        .Top = 50
        .Left = 530
        .Height = 400
        .Width = 400

    Do Until Not IE.Busy And IE.readyState = 4
        DoEvents
    Loop

    End With

' Collect data from tables
    Set tbl = IE.document.getElementsByTagName("table")
    For Each itm In tbl
        i = 1
        For Each itm2 In itm.Rows
            For Each cell In itm2.Cells
                ActiveSheet.Cells(i, 5) = cell.innertext
                i = i + 1
            Next
        Next
    Next

' Click on the 6 buttons, substitute "week", "year", etc. for the button you want to click
    Set Results = IE.document.getElementsByTagName("a")
    For Each itm In Results
        If InStr(1, itm.innertext, "month", vbTextCompare) > 0 Then
            itm.Click

            Do Until Not IE.Busy And IE.readyState = 4
                DoEvents
            Loop
            Exit For
        End If
    Next

' Do whatever is next

End Sub

使用基于XMLHTTP对象的VBA刮取动态网页

1 个答案: