VBA / DOM - 根据属性获取元素

时间:2016-10-27 10:24:36

标签: vba excel-vba dom excel

Windows 7上的Excel 2013 XPath / Javascript / jQuery超出了范围。

我正在尝试迭代页面中的select div元素,即具有特定data-level属性的元素。

我当前的方法是similar to this,但我无法找到基于属性选择元素的非手动方式。我最接近的是:

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", url, False
    .Send
    pHTML.body.innerHTML = .ResponseText
End With

Set eCollection = pHTML.getElementsByClassName("chapter").getElementsByTagName("div")

For i = 0 To eCollection.Length
    If eCollection(i).getAttribute("data-level") >= 0 Then ' Throw cake
Next i

这个解决方案,虽然我确信它是可行的(如果不优雅),如果只是因为当我开始寻找中的特定元素和元素序列时,循环最终会变得多么大似乎是次优的这些元素

所以我正在寻找一种方法来做这样的事情:

For Each pElement In pHTML.getElementsByClassName("chapter").getElementsByTagName("div").getElementsByAttribute("data-level")
    ' Throw cake at the element
Next

我知道没有方法getElementsByAttribute,因此问题 这里有一些我无视的方法,还是我被锁定到手动迭代?

或者,如果我交换当前的方法来创建IE实例,álathis answer,我是否可以使用querySelectorAll来最终得到类似于我上面概述的结果的东西?

1 个答案:

答案 0 :(得分:4)

对于任何其他人来说,外壳,可以说,看起来像这样:

Sub ScrapeWithHTMLObj(url As String, domClassName As String, domTag As String, domAttribute As String, domAttributeValue As String)
    ' Dependencies:
    ' * Microsoft HTML Object Library

    ' Declare vars
    Dim pHTML As HTMLDocument
    Dim pElements As Object, pElement As Object

    Set pHTML = New HTMLDocument

    ' Basic URL healthcheck
    Do While (url = "" Or (Left(url, 7) <> "http://" And Left(url, 8) <> "https://"))
        MsgBox ("Invalid URL!")
        url = InputBox("Enter new URL: (0 to terminate)")
        If url = "0" Then Exit Sub
    Loop

    ' Fetch page at URL
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", url, False
        .Send
        pHTML.body.innerHTML = .ResponseText
    End With

    ' Declare page elements
    Set pElements = pHTML.getElementsByClassName(domClassName)
    Set pElement = pElements(0).getElementsByTagName(domTag)

    ' Extract only elements with wanted attribute
    pEleArray = getElementsByAttribute(pElement, domAttribute, domAttributeValue)

    For Each e In pEleArray
        ' Do stuff to elements
        Debug.Print e.getAttribute(domAttribute)
    Next
End Sub

如果你走这条路,你还需要这样的东西:

Function getElementsByAttribute(pObj As Object, domAttribute As String, domAttributeValue As String) As Object()
    Dim oTemp() As Object
    ReDim oTemp(1 To 1)

    For i = 0 To pObj.Length - 1
        'Debug.Print pObj(i).getAttribute(domAttribute)
        If pObj(i).getAttribute(domAttribute) = domAttributeValue Then
            Set oTemp(UBound(oTemp)) = pObj(i)
            ReDim Preserve oTemp(1 To UBound(oTemp) + 1)
        End If
    Next i

    ReDim Preserve oTemp(1 To UBound(oTemp) - 1)

    getElementsByAttribute = oTemp
End Function

根据HTML树的不同,您显然需要更改子网中归零的元素。对于我在测试中使用的网站,这种结构完美无缺。

用法示例:
Call ScrapeWithHTMLObj("https://somesite", "chapter-index", "div", "data-level", "1")

它将进入名为chapter-index的第一个类,选择包含div标记的所有元素,最后提取包含值为data-level的属性1的所有元素。< / p>