如何在MSXML - VBA中获取XML元素的数组索引?

时间:2017-04-03 19:30:15

标签: xml vba excel-vba excel

我需要将XML文件转换为Excel。所以我想检索XML作为名称值对并唯一地命名列。有没有方法来获取节点的XML数组索引?下面是示例XML,我想知道 productInfo 字段的索引。

Sub GenKeyValues()

    Dim xmlDoc As MSXML2.DOMDocument60
    Dim xmlNodes As MSXML2.IXMLDOMNodeList
    Dim xNode As MSXML2.IXMLDOMNode
    Dim cNode As MSXML2.IXMLDOMNode
    Dim ccNode As MSXML2.IXMLDOMNode
    Dim KeyNo As Variant
    Dim dic

    Set dic = CreateObject("Scripting.Dictionary")

    Dim CurrVal
    Dim Cnt As Integer

    CurrVal = <<<<<Im reading the XML from the file to a string from another method>>>>>
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    With xmlDoc
        .async = False
        .validateOnParse = True
        .LoadXML CurrVal
    End With

    Set xmlNodes = xmlDoc.ChildNodes

    cnt = 0

    For Each xNode In xmlNodes

        If xNode.HasChildNodes Then
             For Each cNode In xNode.ChildNodes
                 If cNode.ChildNodes.Length > 1 Then
                     cnt = cnt + 1
                          For Each ccNode In cNode.ChildNodes
                              Key = ccNode.ParentNode.BaseName + CStr(cnt) + "_" + ccNode.BaseName
                              Val = ccNode.nodeTypedValue
                              dic.Add Key, Val
                          Next
                 Else
                    Key = cNode.BaseName
                    Val = cNode.nodeTypedValue
                    dic.Add Key, Val
                 End If
             Next
       End If
    Next

    For Each KeyNo In dic.Keys
       MsgBox ("Key: " & KeyNo & " Value: " & dic(KeyNo))
    Next

End Sub

Desired Output

请注意,这只是我提供的示例请求xml。任何给定的XML都应转换为唯一的键值对键并加载到excel

示例代码段:

foodoInfo0_Country
foodoInfo0_Currency
productInfo0_itemNo
productInfo0_itemName
productInfo1_itemNo
productInfo1_itemName
productInfo2_itemNo

我已经检索了以下键:

<rule id="1.1">
</rule>
<rule id="1.2">
</rule>
<rule id="1.3">
</rule>
<rule id="Id. 4.3">
</rule>
<rule id="Id. 4.9">
</rule>
<rule id="Id. 4.10">
</rule>
<rule id="Id. 4.11">
</rule>
<rule id="Id. 4.12">
</rule>

productInfo2_itemName

2 个答案:

答案 0 :(得分:1)

考虑XSLT,这是一种专用语言,旨在将XML文件转换为最终用途格式,包括其他XML文件,HTML文件,甚至文本文件。在这里,XSLT可以将您的结构转换为具有所需标头和数据行的CSV格式。 MSXML可以运行XSLT 1.0脚本,避免嵌套的forif逻辑以及数组或字典的使用。

XSLT (另存为要在VBA中读取的.xsl文件;注意:XSL脚本是XML文件)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
   <xsl:output method="text" indent="yes"/> 
   <xsl:strip-space elements="*"/>

   <xsl:template match="/productInfoRequest">      
      <xsl:call-template name="rows">
        <xsl:with-param name="data" select="foodoInfo|productInfo"/>
      </xsl:call-template>   
   </xsl:template>

   <xsl:template name="rows">
      <xsl:param name="data"/>

      <!-- HEADERS -->
      <xsl:for-each select="$data">
        <xsl:value-of select="concat(name(), position(), '_', name(*[1]))"/>
        <xsl:text>,</xsl:text>
        <xsl:value-of select="concat(name(), position(), '_', name(*[2]))"/>        
        <xsl:if test="position() != last()"><xsl:text>,</xsl:text></xsl:if>
      </xsl:for-each>

      <xsl:text>&#xa;</xsl:text>

      <!-- DATA -->
      <xsl:for-each select="$data">
        <xsl:value-of select="concat(node()[1], ',', node()[2])"/>
        <xsl:if test="position() != last()"><xsl:text>,</xsl:text></xsl:if>
      </xsl:for-each>
   </xsl:template>

</xsl:stylesheet>

<强> VBA

Public Sub RunXSLTtoCSV()
    Dim xmlDoc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60
    Dim txtOutput As String, csvfile As String

    ' LOAD XML AND XSL
    xmlDoc.LoadXML CurrVal
    xmlDoc.async = False
    xslDoc.Load "C:\Path\To\XSLScript.xsl"
    xslDoc.async = False

    ' TRANSFORM TO TEXT
    txtOutput = xmlDoc.transformNode(xslDoc)

    ' SAVE TO CSV
    csvfile = "C:\Path\To\CSV.csv"
    Open csvfile For Output As #1
        Print #1, txtOutput
    Close #1

    Set xslDoc = Nothing
    Set xmlDoc = Nothing
End Sub

CSV 输出

当然这是一个csv文件,而不是Excel工作簿。因此,请将内容保存或加载到工作簿中。

CSV Output Screenshot

答案 1 :(得分:0)

我认为你正在寻找一个神奇的药丸愿望会自动为你转换一切,或者我只是不明白你的最终结果。但是,XML是一种标准,当您接收XML时,您通常会同意接收它的内容和方式。话虽这么说,但我并不完全明白你在阅读根元素时遇到的问题是什么。 ("/productInfoRequest")如果这个元素不是根元素而不是什么? 为了解析方式,您想解析我们必须对我们读取XML的方式进行一些更改。查看更新的代码并运行它。这将打印值并按照您在las注释中描述的方式将值添加到字典中。 同样,您需要通过转到工具 - &gt;添加对Microsoft XML,V6.0库的引用。引用。

这是代码。

Sub GenKeyValues()

    Dim xmlDoc As MSXML2.DOMDocument60
    Dim xmlNodes As MSXML2.IXMLDOMNodeList
    Dim xNode As MSXML2.IXMLDOMNode
    Dim cNode As MSXML2.IXMLDOMNode
    Dim ccNode As MSXML2.IXMLDOMNode
    Dim KeyNo As Variant
    Dim val As Variant
    Dim oXml As MSXML2.DOMDocument60
    Dim tempProduct As Variant
    Dim ItemName As String
    Dim ItemValue As String

    Set oXml = New MSXML2.DOMDocument60

     XML = "<productInfoRequest>  <CheckIn>false</CheckIn> <timeStamp>2016-11-02T15:49:57.337-05:00</timeStamp>  <foodoInfo>  <Country>USA</Country>" + _
       "<Currency>USD</Currency>   </foodoInfo>   <productInfo>   <itemNo>1</itemNo>   <itemName>Sample</itemName>   </productInfo>   <productInfo>   <itemNo>2</itemNo>" + _
  "<itemName>Sample</itemName>   </productInfo>   <productInfo>   <itemNo>3</itemNo>   <itemName>Sample</itemName>   </productInfo>   <productInfo>   <itemNo>4</itemNo>" + _
  "<itemName>Sample</itemName>   </productInfo>   </productInfoRequest> "

     oXml.LoadXML XML

    Set dic = CreateObject("Scripting.Dictionary")
    Set productdic = CreateObject("Scripting.Dictionary")
    Dim CurrVal
    Dim Cnt As Integer

    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")

    With xmlDoc
        .async = False
        .validateOnParse = True
        .LoadXML CurrVal
    End With

    Set xmlNodes = oXml.SelectNodes("/productInfoRequest")
    Set productNodes = oXml.SelectNodes("/productInfoRequest/productInfo")

    Cnt = 0
    pcnt = 0

   For Each xNode In productNodes

        If xNode.HasChildNodes Then
             For Each cNode In xNode.ChildNodes
          ' by product loop the children and add once completed 
          ' add it to the dictionary
                  If cNode.BaseName = "itemName" Then
                     ItemName = cNode.BaseName
                     tempProduct = Array("product_Info" & CStr(pcnt) & cNode.BaseName)
                     tempProduct = Array(cNode.nodeTypedValue)
                     End If

                     If cNode.BaseName = "itemNo" Then
                     ItemValue = cNode.nodeTypedValue

                     End If

             Next

             Key = "productInfo" & CStr(pcnt) & "_" & ItemName
             val = ItemValue
             productdic.Add Key, val
             pcnt = pcnt + 1

       End If
    Next



    For Each xNode In xmlNodes

        If xNode.HasChildNodes Then
             For Each cNode In xNode.ChildNodes
                 If cNode.ChildNodes.Length > 1 Then
                     Cnt = Cnt + 1
                          For Each ccNode In cNode.ChildNodes
                              Key = ccNode.ParentNode.BaseName + CStr(Cnt) + "_" + ccNode.BaseName
                              val = ccNode.nodeTypedValue
                              dic.Add Key, val
                          Next
                 Else
                    Key = cNode.BaseName
                    val = cNode.nodeTypedValue
                    dic.Add Key, val
                 End If
             Next
       End If
    Next

'    For Each KeyNo In dic.Keys
'    Debug.Print ("Key: " & KeyNo & " Value: " & dic(KeyNo))
'    Next

     For Each KeyNo In productdic.Keys
     Debug.Print ("Key: " & KeyNo & " Value: " & productdic(KeyNo))

    Next


End Sub

enter image description here