在excel vba中实现HTMLBaseElement

Question

I need to get an element from html code using it's xpath. I'm using "standart coded function" for that

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

But when i'm trying to execute it with the following code

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

... it just breaks up with "Object variable or With block not set" error. I also tried to implement elem variable with

Set elem = New HTMLBaseElement

... but Excel told me "Invalid use of New keyword". Debugging that process I found out that elem var always equals to nothing. :/

Just in case, I have MS Office 2013, and yes, I checked up my References .

Answer 1

In this loop, you need to exit the loop upon assignment of a return value:

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

Should become:

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

NOTE: You should probably still test for Nothing -ness to avoid unhandled errors, eg:

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