vba - Extracting cell values from excel to xml

Question

My requirement is to export a row from Excel to XML. For example, if spreadsheet looks like this:

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

Then, I need to create a xml based on [Change Indicator]=1.

Column values need to be element tag, not the column header. For example, desired output would be:

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

MessageID and OriginalField values will be keep changing and it is not the same for all.

Appreciate any help.

Answer 1

Consider using the MSXML VBA object to create your XML nodes and tags iteratively, conditional on the fifth column: [Change Indicator] = 1. At the end a pretty print XSLT stylesheet is used to properly line break and indent outputted XML. Do note: a Root tag is added for a well-formed XML file:

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

Output

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