Reading XML (MSInfo32) in VBA for Access

Question

I am trying to import data from MSInfo32 XML file. I want to import only the "System Summary", the "Drives" under the "Component"/"Storage", and the "Program Groups" under the "Software Environment".

Here is the snippet of the xml file:

<?xml version="1.0"?>
<MsInfo>
<Metadata>
<Version>8.0</Version>
<CreationUTC>09/18/17 03:42:48</CreationUTC>
</Metadata>
<Category name="System Summary">
<Data>
<Item><![CDATA[OS Name]]></Item>
<Value><![CDATA[Microsoft Windows 10 Pro]]></Value>
</Data>
    <Category name="Components">
        <Category name="Storage">
            <Category name="Drives">
                <Data>
                <Item><![CDATA[Drive]]></Item>
                <Value><![CDATA[C:]]></Value>
                </Data>
            </Category>
        </Category>
    </Category>
    <Category name="Software Environment">
        <Category name="Environment Variables">
        </Category>
        <Category name="Program Groups">
            <Data>
            <Group_Name><![CDATA[Start Menu\Programs\Accessibility]]></Group_Name>
            <Name><![CDATA[Default:Start Menu\Programs\Accessibility]]></Name>
            <User_Name><![CDATA[Default]]></User_Name>
            </Data>
        </Category>
    </Category>
</Category>
</MsInfo>

here is my poor code:

Private Sub xxReadXML()
    Dim xDoc As Object, root As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False

    If xDoc.Load(SystemInfoFileTxt.Value) Then
        ' The document loaded successfully.
        ' Now do something intersting.
        Set MSInfoNode = xDoc.DocumentElement.childNodes(0)
        Set CategoryNode = xDoc.DocumentElement.childNodes(1)
        Set DataNode = xDoc.DocumentElement.childNodes(2)

        For Each DataNode In xDoc.selectNodes("/MsInfo/Category/Data")
            Set ItemNode = DataNode.SelectSingleNode("Item")
            Set ValueNode = DataNode.SelectSingleNode("Value")
            If Not ItemNode Is Nothing Then
                ListBox1.AddItem (ItemNode.Text)
            End If
            If Not ValueNode Is Nothing Then
                ListBox1.AddItem (ValueNode.Text)
            End If
            ListBox1.AddItem ("")
         Next DataNode
    Else
    End If
Set xDoc = Nothing
End Sub

Thanks in advance

Answer 1

I've written up a small XML parser that just runs through the node up to 4 levels deep, printing the name attribute if present, and printing its content if it has no child nodes (writing a recursive one probably would've taken less effort, but this is easier to customize).

This approximates the behavior you want. You will need to do some customization, but because I don't exactly get the system in your output, I can't do it for you.

I've also switched to MSXML2 v6.0 and early bindings

Private Sub xxReadXML()
    Dim xDoc As New MSXML2.DOMDocument60
    Dim root As XMLNode
    xDoc.async = False
    xDoc.validateOnParse = False
    Dim CategoryNode As IXMLDOMNode
    Dim DataNode As IXMLDOMNode
    Dim DataChild As IXMLDOMNode
    Dim DataChild2 As IXMLDOMNode
    Dim DataChild3 As IXMLDOMNode
    Dim DataChild4 As IXMLDOMNode
    If xDoc.Load(SystemInfoFileTxt.Value) Then
        ' The document loaded successfully.
        Set CategoryNode = xDoc.SelectSingleNode("/MsInfo/Category")
        Debug.Print CategoryNode.Attributes.getNamedItem("name").NodeValue
        For Each DataNode In CategoryNode.ChildNodes
            If DataNode.Attributes.length <> 0 Then
                Debug.Print DataNode.Attributes.getNamedItem("name").NodeValue
            End If
            For Each DataChild In DataNode.ChildNodes
                If DataChild.Attributes.length <> 0 Then
                    Debug.Print DataChild.Attributes.getNamedItem("name").NodeValue
                End If

                For Each DataChild2 In DataChild.ChildNodes
                    If DataChild2.HasChildNodes Then
                        If DataChild2.Attributes.length <> 0 Then
                            Debug.Print DataChild2.Attributes.getNamedItem("name").NodeValue
                        End If
                        For Each DataChild3 In DataChild2.ChildNodes
                            If DataChild3.HasChildNodes Then
                                If DataChild3.Attributes.length <> 0 Then
                                    Debug.Print DataChild3.Attributes.getNamedItem("name").NodeValue
                                End If
                                For Each DataChild4 In DataChild3.ChildNodes
                                    Debug.Print DataChild4.Text
                                Next DataChild4
                            Else
                                Debug.Print DataChild3.Text
                            End If
                        Next DataChild3
                    Else
                        Debug.Print DataChild2.Text
                    End If
                Next DataChild2

            Next DataChild
        Next DataNode
    End If
    Set xDoc = Nothing
End Sub