html - 在Excel vba中实现HTMLBaseElement

Question

我需要使用它的 xpath 从 html 代码中获取一个元素。我为此使用“标准编码函数”

Public Function getXPathElement(sXPath As String, objElement As Object) As 

HTMLBaseElement
    Dim sXPathArray() As String

    Dim sNodeName As String
    Dim sNodeNameIndex As String
    Dim sRestOfXPath As String
    Dim lNodeIndex As Long
    Dim lCount As Long

     ' Split the xpath statement
    sXPathArray = Split(sXPath, "/")
    sNodeNameIndex = sXPathArray(1)
    If Not InStr(sNodeNameIndex, "[") > 0 Then
        sNodeName = sNodeNameIndex
        lNodeIndex = 1
    Else
        sXPathArray = Split(sNodeNameIndex, "[")
        sNodeName = sXPathArray(0)
        lNodeIndex = CLng(Left(sXPathArray(1), Len(sXPathArray(1)) - 1))
    End If
    sRestOfXPath = Right(sXPath, Len(sXPath) - (Len(sNodeNameIndex) + 1))

    Set getXPathElement = Nothing
    For lCount = 0 To objElement.ChildNodes().Length - 1
        If UCase(objElement.ChildNodes().Item(lCount).nodeName) = UCase(sNodeName) Then
            If lNodeIndex = 1 Then
                If sRestOfXPath = "" Then
                    Set getXPathElement = objElement.ChildNodes().Item(lCount)
                Else
                    Set getXPathElement = getXPathElement(sRestOfXPath, objElement.ChildNodes().Item(lCount))
                End If
            End If
            lNodeIndex = lNodeIndex - 1
        End If
    Next lCount
End Function

但是当我尝试使用以下代码执行它时

Dim elem As HTMLBaseElement
Dim oHTML As New HTMLDocument

oHTML.body.innerHTML = GetHTML("http://ya.ru")

Set elem = getXPathElement("/html/body/table/", oHTML)

MsgBox elem.InnerText

...它只是因“对象变量或未设置 block ”错误而中断。我还尝试使用 elem 变量来实现

Set elem = New HTMLBaseElement

...但 Excel 告诉我“New 关键字的使用无效”。调试该过程时我发现 elem var 始终等于零。 :/

以防万一，我有 MS Office 2013，是的，我检查了我的引用。

Answer 1

在此循环中，您需要在分配返回值后退出循环:

For lCount = 0 To objElement.ChildNodes().Length - 1
    If UCase(objElement.ChildNodes().Item(lCount).nodeName) = UCase(sNodeName) Then
        If lNodeIndex = 1 Then
            If sRestOfXPath = "" Then
                Set getXPathElement = objElement.ChildNodes().Item(lCount)
            Else
                Set getXPathElement = getXPathElement(sRestOfXPath, objElement.ChildNodes().Item(lCount))
            End If
        End If
        lNodeIndex = lNodeIndex - 1
    End If
Next lCount

应该变成:

For lCount = 0 To objElement.ChildNodes().Length - 1
    If UCase(objElement.ChildNodes().Item(lCount).nodeName) = UCase(sNodeName) Then
        If lNodeIndex = 1 Then
            If sRestOfXPath = "" Then
                Set getXPathElement = objElement.ChildNodes().Item(lCount)
                Exit For
            Else
                Set getXPathElement = getXPathElement(sRestOfXPath, objElement.ChildNodes().Item(lCount))
                Exit For
            End If
        End If
        lNodeIndex = lNodeIndex - 1
    End If
Next lCount

注意:您可能仍然应该测试 Nothing-ness 以避免未处理的错误，例如:

Set elem = getXPathElement("/html/body/table/", oHTML)
If elem Is Nothing Then
    MsgBox "Error!", vbINformation
    Exit Sub 'etc...
End If
MsgBox elem.InnerText