访问xml DOM文档所有节点,并且输出节点所在的层

Option Explicit

Private lRowNumber As Long



Public Sub XmlTest(sFilePath As String)

    Dim xDoc As MSXML2.DOMDocument

    Dim xRoot As MSXML2.IXMLDOMNode

    Dim fSuccess As Boolean

    

    Set xDoc = New MSXML2.DOMDocument

    ' Load the  XML from the specified path,

    ' either from a local disk, over the network using UNC references, or via a URL.

    ' Wait for the load to finish before proceeding.

    xDoc.async = False

    xDoc.validateOnParse = True

    fSuccess = xDoc.Load(sFilePath)

    

    ' If the document failed to load, display error information then quit.

    If Not fSuccess Then

        Dim strErrText As String

        Dim xPE As MSXML2.IXMLDOMParseError

        ' Obtain the ParseError object

        Set xPE = xDoc.parseError

        With xPE

          strErrText = "Your XML Document failed to load " & _

            "due the following error." & vbCrLf & _

            "Error #: " & .errorCode & ", " & xPE.reason & _

            "Line #: " & .Line & vbCrLf & _

            "Line Position: " & .linepos & vbCrLf & _

            "Position In File: " & .filepos & vbCrLf & _

            "Source Text: " & .srcText & vbCrLf & _

            "Document URL: " & .URL

        End With

        MsgBox strErrText, vbExclamation, "Fialed to load"

        Set xPE = Nothing

        Exit Sub

    End If

   

    ' Clear previous data.

    Worksheets(1).Columns("A:B").ClearContents

    ' Create column headers and make the width of these columns autofit.

    Worksheets(1).Cells(1, 1) = "ElementName"

    Worksheets(1).Cells(1, 2) = "DepthNumber"

    Worksheets(1).Columns("A:B").AutoFit

    ' Set the number of presently last row of the used data range.

    lRowNumber = 1

    ' Get the root element of the XML DOM tree and process all subtrees of it.

    Set xRoot = xDoc.documentElement

    ProcessSubtrees xRoot, 0

    ' Display the result.

    MsgBox "Totally " & lRowNumber - 1 & " element nodes in the XML DOM tree.", , "Completed"

    ' Release the references.

    Set xRoot = Nothing

    Set xDoc = Nothing

End Sub



Sub ProcessSubtrees(ByRef xNode As MSXML2.IXMLDOMNode, ByVal intDepth As Integer)

    Dim xChildren As MSXML2.IXMLDOMNodeList

    Dim xChild As MSXML2.IXMLDOMNode

    lRowNumber = lRowNumber + 1

    Worksheets(1).Cells(lRowNumber, 1).Value = xNode.nodeName

    Worksheets(1).Cells(lRowNumber, 2).Value = intDepth

    If Not xNode.hasChildNodes() Then Exit Sub  'if no children

    Set xChildren = xNode.childNodes



    ' Go through all subtrees of xNode.

    For Each xChild In xChildren

        ' Process only element nodes.

        If xChild.nodeType = NODE_ELEMENT Then ProcessSubtrees xChild, intDepth + 1

    Next xChild

    Set xChild = Nothing

    Set xChildren = Nothing

End Sub

XmlTest "http://chinese.wsj.com/gb/rss01.xml"

或者

Call XmlTest("http://chinese.wsj.com/gb/rss01.xml")