将单元格值从excel提取到xml

时间:2016-05-20 10:18:42

标签: xml excel vba excel-vba

我的要求是将一行从Excel导出到XML。例如,如果电子表格如下所示:

MessageID  OriginalField    OriginalCOBO  RevisedCOBOL        ChangeIndicator
I23456I    SDQ              SOURCE        SOURCE-DATA-QUEUE   1

然后,我需要根据[Change Indicator]=1创建一个xml。

列值必须是元素标记,而不是列标题。例如,期望的输出将是:

<I23456I>
<SDQ>
    <COBOLName>SOURCE-DATA-QUEUE</COBOLName>
</SDQ>
</I23456I>

MessageIDOriginalField值将不断变化,并且对所有人来说都不一样。

感谢任何帮助。

1 个答案:

答案 0 :(得分:1)

考虑使用MSXML VBA对象迭代地创建XML节点和标记,条件是第五列:[Change Indicator] = 1。最后,一个漂亮的打印XSLT样式表用于正确地换行和缩进输出的XML。请注意:为格式良好的XML文件添加了Root标记:

Sub xmlExport()
    ' Add Microsoft XML v6.0 VBA Reference '
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60
    Dim newDoc As New MSXML2.DOMDocument60
    Dim root As IXMLDOMElement, msgNode As IXMLDOMElement
    Dim orgfldNode As IXMLDOMElement, orgcoboNode As IXMLDOMElement
    Dim i As Long

    ' DECLARE XML DOC OBJECT '
    Set root = doc.createElement("Root")
    doc.appendChild root

    ' WRITE TO XML '
    For i = 2 To Sheets(1).UsedRange.Rows.Count

        If Cells(i, 5) = 1 Then

            ' MESSAGE NODE '
            Set msgNode = doc.createElement(Cells(i, 1))
            root.appendChild msgNode

            ' ORIGINAL FIELD NODE '
            Set orgfldNode = doc.createElement(Cells(i, 2))
            msgNode.appendChild orgfldNode

            ' ORIGINAL COBO NODE '
            Set orgcoboNode = doc.createElement("COBOLNAME")
            orgcoboNode.Text = Cells(i, 4)
            orgfldNode.appendChild orgcoboNode
        End If

    Next i

    ' PRETTY PRINT RAW OUTPUT '
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
        & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
        & "            xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
        & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
        & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
        & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
        & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
        & "  <xsl:copy>" _
        & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
        & "  </xsl:copy>" _
        & " </xsl:template>" _
        & "</xsl:stylesheet>"

    xslDoc.async = False
    doc.transformNodeToObject xslDoc, newDoc
    newDoc.Save ActiveWorkbook.Path & "\Output.xml"

End Sub

<强>输出

<?xml version="1.0" encoding="UTF-8"?>
<Root>
    <I23456I>
        <SDQ>
            <COBOLNAME>SOURCE-DATA-QUEUE</COBOLNAME>
        </SDQ>
    </I23456I>
</Root>