使用 Excel 和 VBA 进行 StockCharts 网页抓取

Question

我正在尝试使用 Excel 和 VBA 从 StockCharts 获取数据。我可以列出标题但不能列出数据。有人可以帮我解决这个问题吗？

这是代码：

Sub Scraping_StockCharts()

    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim HTMLIm As MSHTML.IHTMLElement
    Dim HTMLIms As MSHTML.IHTMLElementCollection
    Dim URL As String
    
    Sheets("Results").Range("a1:z10000").ClearContents
    
    URL = "https://stockcharts.com/freecharts/sectorsummary.html?&G=SECTOR_DJUSHP&O=1"
    
    XMLPage.Open "Get", URL, False
    XMLPage.setRequestHeader "Content-Type", "text/xml"
    
    XMLPage.send
    
    HTMLDoc.body.innerHTML = XMLPage.responseText

    Set HTMLIms = HTMLDoc.getElementsByTagName("th")
    
    Row = 1
    Column = 1
           
        For Each HTMLIm In HTMLIms
         
                Sheets("Results").Cells(Row, Column).Value = HTMLIm.innerText
                Column = Column + 1
        
        Next HTMLIm

    Set HTMLIms = HTMLDoc.getElementsByTagName("td")
    
    Row = 2
    Column = 1
      
        For Each HTMLIm In HTMLIms
            
                Sheets("Results").Cells(Row, Column).Value = HTMLIm.innerText
                Column = Column + 1
        Next HTMLIm
        
End Sub

Answer 1

我会这样做的。

Sub Web_Table_Option_Two()
    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    objIE.Navigate "https://stockcharts.com/freecharts/sectorsummary.html?&G=SECTOR_DJUSHP&O=1"

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
    HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
        Set objTable = .getElementsByTagName("table")
        For lngTable = 0 To objTable.Length - 1
            For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                Next lngCol
            Next lngRow
            ActRw = ActRw + objTable(lngTable).Rows.Length + 1
        Next lngTable
    End With
    objIE.Quit
End Sub