在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

...它只是分解为“对象变量或未设置块”错误。 我也试过用它来实现elem变量

Set elem = New HTMLBaseElement

...但Excel告诉我“新关键字的使用无效”。 调试那个过程我发现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