Question

我正在开发一个用于Excel的VBA宏，它可以自动将XML-Files中的值导入数组并将它们粘贴到某个工作表中。我简化了代码并将其粘贴在下面。目前，它在节点列表“AllocationTimeSeries”中搜索节点“TimeSeriesIdentification”并将值复制到数组中（我将创建一个多维数组来存储其他条目）。虽然它只在文档中出现一次，但我也希望保存节点“DocumentVersion”。但是我应该将其声明为xmlNodeList，因为“DocumentVersion”与“AllocationTimeSeries”位于同一树级别？不幸的是，“TotalAllocationResultDocument”不起作用......

Dim xmlDoc As MSXML2.DOMDocument60
Dim xmlElement As MSXML2.IXMLDOMElement
Dim xmlNodeList As MSXML2.IXMLDOMNodeList
Dim xmlNode As MSXML2.IXMLDOMNode
Dim xmlAttribute As MSXML2.IXMLDOMAttribute
Dim strFilePath As String
Dim arrx As Integer
Dim arrStrings As Variant

Set xmlDoc = New MSXML2.DOMDocument60
    With xmlDoc
        .async = False
        .setProperty "ProhibitDTD", False
        .validateOnParse = False
        .resolveExternals = False
    End With

strFilePath = "C:\Desktop\testfolder\testfile.xml"

If Not xmlDoc.Load(strFilePath) Then
    MsgBox ("File loading failed!")
    Exit Sub
End If

Set xmlElement = xmlDoc.DocumentElement
Set xmlNodeList = xmlElement.SelectNodes("AllocationTimeSeries")
arrx = 1
ReDim arrStrings(100) As Variant

For Each xmlNode In xmlNodeList
    arrStrings(arrx) = xmlNode.SelectSingleNode("TimeSeriesIdentification").Attributes.getNamedItem("v").Text
Next xmlNode

Worksheets("Table1").Activate

For i = 1 To arrx
    Cells (1 + i, 1).Value = arrStrings(i)
Next i

Set xmlDoc = Nothing

这将是我正在使用的xml的一部分：

-<TotalAllocationResultDocument xsi:noNamespaceSchemaLocation="total-allocation-result-document.xsd" DtdVersion="4" DtdRelease="0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
    <DocumentIdentification v="DAILYPRODU-170301-01"/>
    <DocumentVersion v="1"/>
    <DocumentType v="A25"/>
    <SenderIdentification v="SENDERA" codingScheme="A01"/>
    <ReceiverIdentification v="RECEIVERA" codingScheme="A01"/>
   -<AllocationTimeSeries>
        <TimeSeriesIdentification v="TotalAllocationResults_TS_1982400"/>
        <BidDocumentVersion v="2"/>
        <AuctionIdentification v="D-DAILYPRODU-170301-01"/>
       -<Period>
            <TimeInterval v="2017-02-28T23:00Z/2017-03-01T23:00Z"/>
            <Resolution v="PT60M"/>
           -<Interval>
                <Pos v="1"/>
                <Qty v="1.0"/>
                <PriceAmount v="14.42"/>
            </Interval>
           -<Interval>
                <Pos v="2"/>
                <Qty v="3.0"/>
                <PriceAmount v="14.65"/>
           -<Interval>
        </Period>
    </AllocationTimeSeries>
   -<AllocationTimeSeries>
        <TimeSeriesIdentification v="TotalAllocationResults_TS_1982400"/>
        <BidDocumentVersion v="2"/>
        <AuctionIdentification v="D-DAILYPRODU-170301-01"/>
       -<Period>
            <TimeInterval v="2017-02-28T23:00Z/2017-03-01T23:00Z"/>
            <Resolution v="PT60M"/>
           -<Interval>
                <Pos v="1"/>
                <Qty v="5.0"/>
                <PriceAmount v="14.02"/>
            </Interval>
           -<Interval>
                <Pos v="2"/>
                <Qty v="3.0"/>
                <PriceAmount v="14.67"/>
           -<Interval>
        </Period>
    </AllocationTimeSeries>
</TotalAllocationResultDocument>

我为使用条款和混乱的编码结构而道歉，我刚刚开始使用VBA，就像两周前一样，还有很多需要学习的地方。

Answer 1

只需使用xmlElement选择其子 DocumentVersion ，因为它不属于 AllocationTimeSeries 节点列表。此外，下面的代码会运行一些您可以考虑的调整：

无需将已解析的xml数据存储在任何数组中，而是直接将值输出到工作表。
在一般的VBA编程中，使用错误处理，特别是在这种情况下，使用MSXML的parseError替换If Load电话上的Option Explicit。
在一般的VBA编程中，使用模块顶部的<Interval>（在所有宏之上），这会在当前代码维护的未分配对象/变量上引发编译错误。
即使程序遇到错误，也取消初始化所有设置对象，而不仅仅是 xmlDoc ，以释放此类资源。请参阅错误处理中的实现。
确保使用格式良好的XML文件。您发布的示例没有正确关闭Option Explicit Sub XMLParse() On Error GoTo ErrHandle Dim strFilePath As String Dim xmlDoc As MSXML2.DOMDocument60 Dim xmlElement As IXMLDOMElement Dim xmlNodeList As IXMLDOMNodeList Dim xmlNode As IXMLDOMNode Dim i As Long Set xmlDoc = New MSXML2.DOMDocument60 With xmlDoc .async = False .setProperty "ProhibitDTD", False .validateOnParse = False .resolveExternals = False End With strFilePath = "C:\Desktop\testfolder\testfile.xml" xmlDoc.Load strFilePath Set xmlElement = xmlDoc.DocumentElement Set xmlNodeList = xmlElement.SelectNodes("AllocationTimeSeries") i = 1 For Each xmlNode In xmlNodeList Worksheets("Table1").Cells(i, 1).Value = xmlElement.SelectSingleNode("DocumentVersion").Attributes.getNamedItem("v").Text Worksheets("Table1").Cells(i, 2).Value = xmlNode.SelectSingleNode("TimeSeriesIdentification").Attributes.getNamedItem("v").Text i = i + 1 Next xmlNode ExitSub: Set xmlElement = Nothing Set xmlNodeList = Nothing Set xmlDoc = Nothing Exit Sub ErrHandle: If xmlDoc.parseError.reason <> "" Then MsgBox xmlDoc.parseError.reason, vbCritical, "XML ERROR" Else MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR" End If Resume ExitSub End Sub个节点，这会引发运行时错误。

VBA

{{1}}

在XML文档中搜索最高节点级别

1 个答案: