解析HTML getElementsByTagName不返回所有单元格

问题描述 投票:0回答:1

我有一些代码用于从网页上抓取数据,但网页已经更改,无法再使其工作。该代码应该在内部事务表上进行计算,但是getelementsbytagname("td")不再返回所有单元格。

我猜它是因为它是一个嵌入页面或其他东西的页面,但我不能为我的生活解决它,我对html不是很熟悉。示例网页是gurufocus.com/stock/lmb/insider

我的代码如下:

Sub getStatements()
    Dim wb As Object
    Dim doc As Object
    Dim incomeStmtURLs As Variant
    Dim sURL As String
    Dim allCells As IHTMLElementCollection
    Dim aCell As HTMLTableCell
    Dim i As Integer
    Dim loginBoxData As String    

    Application.DisplayAlerts = False

    Call ToggleEvents(False)

    incomeStmtURLs = Range("Sheet1!h1:h2").Value

    For i = 1 To UBound(incomeStmtURLs)
        Set wb = CreateObject("internetExplorer.Application")
        sURL = incomeStmtURLs(i, 1)

        wb.navigate sURL
        wb.Visible = False

        While wb.Busy
            Application.Wait Now + #12:00:01 AM#
            DoEvents
        Wend

        'HTML document
        Set doc = wb.document

        On Error GoTo err_clear

        ' gets all cell and looks for date format,
        ' goes from new transaction to old so once gets to older than a year it exits for loop
        ' checks nextSibling from date is a buy and if so does calculations, by taking further value sin row
        ' for priceThisTime have to get rid of $ symbol for calculation
        Set allCells = doc.getElementsByTagName("td")
        For Each aCell In allCells
            MsgBox (aCell.innerText)
            If aCell.innerText Like "####-##-##" = True Then
                If CDate(aCell.innerText) >= Date - 365 Then
                    If aCell.NextSibling.innerText = "Buy" Then
                        buys = buys + 1
                        sharesThisTime = CDec(aCell.NextSibling.NextSibling.innerText)
                        priceThisTime = aCell.NextSibling.NextSibling.NextSibling.NextSibling.innerText
                        totalPrice = totalPrice + (sharesThisTime * CDec(Right(priceThisTime, Len(priceThisTime) - 1)))
                        shareCount = shareCount + sharesThisTime
                    End If
                Else
                    Exit For
                End If
            End If
        Next aCell

        Sheet6.Cells(i + 1, 2) = buys
        If (shareCount <> 0) Then
            Sheet6.Cells(i + 1, 3).Value = totalPrice / shareCount
        End If

        buys = 0
        totalPrice = 0
        shareCount = 0

err_clear:
        If Err <> 0 Then
            Err.Clear
            Resume Next
        End If
        wb.Quit
    Next i

    Call ToggleEvents(True)
End Sub
html excel vba web-scraping getelementsbytagname
1个回答
0
投票

以下目标专门针对该表并检索所有td元素。我认为您的逻辑可能会在列数基础上应用,但无论如何(以防万一我将表格也设置为变量)。

我将每页的结果设置为100,但您可以注释掉该行

Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls

Public Sub GetData()
    Dim ie As New InternetExplorer, lastDropDrownItemIndex As Long, dropDown As Object, t As Date
    Const MAX_WAIT_SEC As Long = 10


    With ie
        .Visible = True
        .Navigate2 "https://www.gurufocus.com/stock/lmb/insider"

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer

        Do
            Set dropDown = .document.querySelectorAll(".el-dropdown-menu__item")
            lastDropDrownItemIndex = dropDown.Length - 1
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While lastDropDrownItemIndex < 1

        If dropDown.Length = 0 Then Exit Sub

        dropDown.item(lastDropDrownItemIndex).Click 'comment me out if don't want 100 results per page

        Dim tds As Object, table As Object
        Set tds = .document.getElementsByClassName("data-table")(0).getElementsByTagName("td")
        Set table = .document.getElementsByClassName("data-table")
        Stop
        .Quit
    End With
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.