在excel vba中实现HTMLBaseElement

我需要使用它的xpath从html代码中获取元素。 我正在使用“标准编码function”

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 

…它只是与“对象variables或块未设置”错误分手。 我也试着用elem来实现elemvariables

 Set elem = New HTMLBaseElement 

…但Excel告诉我“新关键字的使用无效”。 debugging这个过程，我发现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 

注意：您应该仍然可以testing“ Nothing以避免未处理的错误，例如：

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