VBA getElementsByTagName() 只返回 102 行

问题描述

我是编码的初学者,所以我很抱歉。

我已经搜索了该网站,但无法解决我的问题,所以需要寻求帮助。

我有以下经过改编的代码。它可以通过打开一个新的 Excel 工作表并命名单元格 A1 TempRes 来运行,然后它会从雅虎财经中提取历史数据。

日期范围是从 08/Jun/201122/Jun/2021,如果您将代码中的 URL 复制粘贴到网络浏览器中(我使用的是 ME),那么您将看到该 URL 包含表格包含所有数据。

当我运行 VBA 时,它虽然只返回 102 行?有谁知道如何获取所有行/我犯了什么错误,所以我只得到 102 行?

Sub Temptest()
    Dim sPageURL As String
    Dim sResName As String
    Dim iTableID As Integer
    
    sPageURL = "https://uk.finance.yahoo.com/quote/BDEV.L/history?period1=1307491200&period2=1624406400&interval=1d&filter=history&frequency=1d"
    sResName = "TempRes"
    iTableID = 0
    
    Call PageScrape_ByObject(sPageURL,sResName,iTableID)
    
End Sub
Sub PageScrape_ByObject(sPageURL As String,sResName As String,iTableID As Integer)

    Dim odom As Object: Set odom = CreateObject("htmlFile")
    Dim x As Long,y As Long
    Dim oRow As Object,oCell As Object
    Dim data
    Dim nRows As Long
    Dim nCols As Long
    Dim resRange As Range

    y = 1: x = 1
    Set resRange = Range(sResName)
    
    ' Clear current results
    resRange.ClearContents
    
    ' Scrape iTableID from sPageURL and dump results
     With CreateObject("msxml2.xmlhttp")
        .Open "GET",sPageURL,False
        .Send
        odom.body.innerHtml = .responseText
    End With
    
    If Not odom Is nothing Then
    With odom.getElementsByTagName("table")(iTableID)
    Dim irows As Integer
    irows = .Rows.Length
    On Error GoTo errorhandler
        ReDim data(1 To .Rows.Length,1 To .Rows(1).Cells.Length)
        For Each oRow In .Rows
            For Each oCell In oRow.Cells
                data(x,y) = oCell.innertext
                y = y + 1
            Next oCell
errorhandler:
            y = 1
            x = x + 1
        Next oRow
    End With
    nRows = UBound(data)
    nCols = UBound(data,2)
    resRange.Cells(1,1).Resize(nRows,nCols).Value = data
    
    ' Create range name over results sResName
    resRange.Resize(nRows,nCols).Name = sResName
    End If
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)