使用具有多个 <Item> 节点的 VBA 读取 XML 文件

Question

我正在尝试读取 XML 文件并将数据加载到 Access 数据库中。我已经确定了需要读取的节点，并将它们分配给我的数据库中的字段，但是在读取实际值时遇到了困难。以下是数据库字段到节点名称的映射：

XL_ColumnName  XML_NodePathAndName
Customer       /n0:PurchaseOrderRequest/PurchaseOrder/BuyerParty/Address/OrganisationFormattedName
PO             /n0:PurchaseOrderRequest/PurchaseOrder/ID
Qty            /n0:PurchaseOrderRequest/PurchaseOrder/Item/n1:ZZHL_ITEM_QTY
DueDate        /n0:PurchaseOrderRequest/PurchaseOrder/Item/n1:ZZSHIPDATE
Price-Each     /n0:PurchaseOrderRequest/PurchaseOrder/Item/Price/NetUnitPrice/Amount
Part_Number    /n0:PurchaseOrderRequest/PurchaseOrder/Item/Product/BuyerID
Description    /n0:PurchaseOrderRequest/PurchaseOrder/Item/Product/Note
Ship To Zip    /n0:PurchaseOrderRequest/PurchaseOrder/Item/ShipToLocation/Address/PhysicalAddress/StreetPostalCode

目前，我用来读取单个节点的代码如下所示：

Public Function ProcessXML(frm As Form)

    Dim xdoc As MSXML2.DOMDocument
    Dim xNode As MSXML2.IXMLDOMNode
    Dim Nodes As MSXML2.IXMLDOMNodeList

    Dim strFilename As String

    Set xdoc = New MSXML2.DOMDocument

    'Load the XML document
    xdoc.validateOnParse = False
    strFilename = frm.txt_Filename
    xdoc.Load (strFilename)

    For Each xNode In xdoc.ChildNodes

        If xNode.NodeType = 7 Then
            'this is "xml", ignore it
        Else

            ReadNodesEx1 xNode

        End If

    Next

End Function

Public Sub ReadNodesEx1(ByRef Node As MSXML2.IXMLDOMNode)

Dim strSQL As String
Dim strValue As String
Dim rs As DAO.Recordset
Dim Nodes As MSXML2.IXMLDOMNodeList

On Error GoTo ProcError

strSQL = "SELECT XML_NodePathAndName, Staging_ColumnName FROM tbl_XML_Schema WHERE Staging_ColumnName IS NOT NULL"
Set rs = GetDB.OpenRecordset(strSQL, dbOpenDynaset, dbFailOnError)

While Not rs.EOF

    strValue = Nz(Node.SelectSingleNode(rs!XML_NodePathAndName).Text, "NULL")
    Debug.Print rs!Staging_ColumnName, rs!XML_NodePathAndName, strValue

NextField:
        rs.MoveNext
    Wend

ProcExit:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Exit Sub

ProcError:
    If Err.Number = 91 Then
        Debug.Print rs!Staging_ColumnName, rs!XML_NodePathAndName, "ITEM NOT FOUND"
        Resume NextField
    Else
        MsgBox Err.Number & vbCrLf & Err.Description, , "ReadNodesEX1"
        Debug.Print "ReadNodesEX1", Err.Number, Err.Description
        Resume ProcExit
        Resume
    End If
End Sub

它可以很好地读取单个节点，但采购订单中可能有多个项目，在这种情况下，客户和采购订单的值对于所有项目都是相同的。我不知道如何解决这个问题，以便我可以多次循环遍历记录集节点名称，直到到达 Item 集合中的最后一个 Item。

我确信这涉及到通过 Items 集合的某种形式的循环，但是我很难制作 VBA 来循环遍历所有 XML“Item”节点以及记录集中定义要读取的特定节点。

Answer 1

编辑：现在有了您的示例 XML：

<?xml version="1.0"?>
<PurchaseOrderRequest>
    <PurchaseOrder>
        <PONumber>1234</PONumber>
        <Customer>ABC Building Supply</Customer>
        <Item>
            <ID>1</ID>
            <ITEM_QTY>3</ITEM_QTY>
        </Item>
        <Item>
            <ID>2</ID>
            <ITEM_QTY>3</ITEM_QTY>
        </Item>
    </PurchaseOrder>
</PurchaseOrderRequest>

使用此代码，您可以迭代并处理您描述的所有内容：

Sub ReadPurchases()
    Dim purchaseOrderRequest As MSXML2.DOMDocument
    Set purchaseOrderRequest = New MSXML2.DOMDocument

    purchaseOrderRequest.validateOnParse = True
    purchaseOrderRequest.SetProperty "SelectionLanguage", "XPath"

    purchaseOrderRequest.Load "z:\purchaseOrderRequest.xml"

    Dim purchaseOrder As IXMLDOMNode
    For Each purchaseOrder In purchaseOrderRequest.selectNodes("PurchaseOrderRequest/PurchaseOrder")
        Debug.Print "PONumber:", purchaseOrder.selectSingleNode("PONumber").Text
        Debug.Print "Customer:", purchaseOrder.selectSingleNode("Customer").Text
        ReadPurchaseOrderItems purchaseOrder.selectNodes("Item")
    Next
End Sub

Sub ReadPurchaseOrderItems(ByVal purchaseOrderItems As MSXML2.IXMLDOMNodeList)
    Dim purchaseOrderItem As IXMLDOMNode
    For Each purchaseOrderItem In purchaseOrderItems
        Debug.Print "  ID:", purchaseOrderItem.selectSingleNode("ID").Text
        Debug.Print "  ITEM_QTY:", purchaseOrderItem.selectSingleNode("ITEM_QTY").Text
    Next
End Sub

输出将是：

PONumber:     1234
Customer:     ABC Building Supply
  ID:         1
  ITEM_QTY:   3
  ID:         2
  ITEM_QTY:   3