在VBA中读取XML(MSInfo32)以进行访问

时间:2017-09-19 21:19:45

标签: xml-parsing access-vba

我正在尝试从MSInfo32 XML文件导入数据。我只想导入“系统摘要”,“组件”/“存储”下的“驱动器”和“软件环境”下的“程序组”。

以下是xml文件的片段:

<?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>

这是我糟糕的代码:

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

提前致谢

1 个答案:

答案 0 :(得分:1)

我已经编写了一个小的XML解析器,它只运行最多4级的节点,打印name属性(如果存在),并打印其内容(如果没有子节点)(写一个递归的)可能会花费更少的精力,但这更容易定制。

这近似于您想要的行为。您需要进行一些自定义,但由于我没有完全在您的输出中获得系统,我无法为您完成。

我也转而使用MSXML2 v6.0和早期绑定

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