使用基於XMLHTTP對象的VBA刮動態網頁

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標籤）和HTML描述6個按鈕：

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