How To Access Hierarchical XML Data with the XML OLE DB Simple Provider

<portfolio>
    <stock>
        <symbol>MSFT</symbol>
        <price>$66.00</price>
        <info>
            <companyname>Microsoft Corporation</companyname>
            <website>http://www.microsoft.com</website>
        </info>
    </stock>
    <stock>
        <symbol>AAPL</symbol>
        <price>$110.00</price>
        <info>
            <companyname>Apple Computer, Inc.</companyname>
            <website>http://www.apple.com</website>
        </info>
    </stock>
    <stock>
        <symbol>DELL</symbol>
        <price>$50.00</price>
        <info>
            <companyname>Dell Corporation</companyname>
            <website>http://www.dell.com</website>
        </info>
    </stock>
    <stock>
        <symbol>INTC</symbol>
        <price>$136.00</price>
        <info>
            <companyname>Intel Corporation</companyname>
            <website>http://www.intel.com</website>
        </info>
    </stock>
</portfolio>
					

Private Sub Command1_Click()
    Dim adoRS As ADODB.Recordset
    Set adoRS = New ADODB.Recordset
    
    ' Set up the Connection
    adoRS.ActiveConnection = "Provider=MSDAOSP; Data Source=MSXML2.DSOControl.2.6;"
    
    ' Open the XML source
    adoRS.Open  "<path to portfolio.xml>"
    On Error GoTo RecError
    printtbl adoRS, 0
    
    GoTo Bye
    
RecError:
    Debug.Print Err.Number & ": " & Err.Description
    If adoRS.State = adStateOpen Then
        For Each Col In adoRS.Fields
            Debug.Print Col.Name & ": " & Col.Status  '  Error Status
        Next Col
    End If
    
Bye:
    If adoRS.State = adStateOpen Then
        adoRS.Close
    End If
    Set adoRS = Nothing
End Sub

' Function to recursively retrieve the data
Sub printtbl(rs, indent)
    On Error Resume Next
    
    Dim rsChild As ADODB.Recordset
    Dim Col As ADODB.Field
    
    While rs.EOF <> True
        For Each Col In rs.Fields
        If Col.Name <> "$Text" Then   ' $Text to be ignored
            If Col.Type <> adChapter Then
                ' Output the non-chaptered column
                Debug.Print Space(indent) & Col.Name & ": " & Col.Value,
            Else
                Debug.Print
                ' Retrieve the Child recordset
                Set rsChild = Col.Value
                rsChild.MoveFirst
                If Err Then MsgBox Error
                printtbl rsChild, indent + 4
                rsChild.Close
                Set rsChild = Nothing
            End If
        End If
        Next
        Debug.Print
        rs.MoveNext
    Wend
    
End Sub