Creating XML file using Excel VBA

I' trying to create xml file from Excel VBA to my work.

Issues I am facing are following.

1. I have spend a days trying to add the structure !-- elementx -- after each element.
2. Also I am not able to get preatty formating.

Belowe you will find my VBA code ( these are myfisrt steps with xml and VBA)

I appreciate your help with this.

Public Sub ExportXMLfile()
Dim doc As Object
Dim Root As Object
Dim pi As Object
Dim Spath As String
Dim Cdata As Object

Dim Product As Object
Dim Element1 As Object
Dim Element2 As Object
Dim Element3 As Object

Set doc = CreateObject("MSXML2.DOMDocument")
Set pi = doc.createProcessingInstruction("xml", " version=""1.0"" encoding=""UTF-8""")
doc.appendChild pi

Set Root = doc.createElement("Document")
doc.appendChild Root
Root.setAttribute "generated", Now
Root.appendChild doc.createTextNode(vbNewLine + vbTab)


Set Root = doc.SelectSingleNode("//Document")

For i = 1 To 3
    
    Set Product = doc.createElement("Product")
    Root.appendChild Product
    Product.appendChild doc.createTextNode(vbNewLine + vbTab + vbTab)
    
    
    Set Element1 = doc.createElement("Element1")
    Product.appendChild Element1
    Set Cdata = doc.createCDATASection("Element1")
    Cdata.Data = i
    Element1.appendChild Cdata
    
    
    
    Set Element2 = doc.createElement("Element2")
    Element2.text = i
    Product.appendChild Element2
    
    
    Set Element3 = doc.createElement("Element3")
    Element3.text = i
    Product.appendChild Element3
    
    Product.appendChild doc.createTextNode(vbNewLine + vbTab)
Next

Root.appendChild doc.createTextNode(vbNewLine)

Debug.Print doc.XML


End Sub

With my code I get the following output so far.

<?xml version="1.0"?>
<Document generated="11/11/2024 10:24:33 AM">
    <Product>
        <Element1><![CDATA[1]]></Element1><Element2>1</Element2><Element3>1</Element3>
    </Product><Product>
        <Element1><![CDATA[2]]></Element1><Element2>2</Element2><Element3>2</Element3>
    </Product><Product>
        <Element1><![CDATA[3]]></Element1><Element2>3</Element2><Element3>3</Element3>
    </Product>
</Document>

The output should actually look like this.

<?xml version="1.0"?>
<Document generated="11/11/2024 10:24:33 AM">
    <Product>
        <Element1><![CDATA[1]]></Element1><!-- element1 -->
        <Element2>1</Element2><!-- element2 -->
        <Element3>1</Element3><!-- element3 -->
    </Product>
    <Product>
        <Element1><![CDATA[2]]></Element1><!-- element1 -->
        <Element2>2</Element2><!-- element2 -->
        <Element3>2</Element3><!-- element3 -->
    </Product>
    <Product>
        <Element1><![CDATA[3]]></Element1><!-- element1 -->
        <Element2>3</Element2><!-- element2 -->
        <Element3>3</Element3><!-- element3 -->
    </Product>
</Document>

This works for me as per your expected output where the generated XML file (Test.xml) will be created in the folder which houses the Excel file.

• Revision-1: Adding comments in the XML table
• Revision-2: Prettify output of the XML table

Sub Test()
    Dim objConn As Object, strArgs As String, strSQL As String, i As Integer
    Dim xDoc As Object, objRoot As Object, myNode As Object, Cdata As Object, newComment As Object
    Dim ChildNode As Variant, New_ChildNode As Variant
    Dim XML_FileName As String, tempFileName As String
    Dim objFSO As Object, objFile As Object, strXML As String, xmlWriter As Object, strOutput As String, objTextFile As Object
    
    Const ForReading = 1
    
    Set xmlWriter = CreateObject("MSXML2.MXXMLWriter")

    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    xDoc.resolveExternals = True
    
    Set objRoot = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    Set objRoot = xDoc.InsertBefore(objRoot, xDoc.ChildNodes.Item(0))
    Set objRoot = xDoc.createElement("Document")
    Set xDoc.DocumentElement = objRoot
    
    objRoot.setAttribute "generated", Now
    
    For i = 1 To 3
        Set myNode = xDoc.SelectSingleNode("//Document")
        
        Set ChildNode = xDoc.createElement("Product")
        myNode.appendChild ChildNode
        
        Set New_ChildNode = xDoc.createElement("Element1")
        ChildNode.appendChild New_ChildNode
        Set Cdata = xDoc.createCDATASection("Element1")
        Cdata.Data = i
        New_ChildNode.appendChild Cdata
        
        Set newComment = xDoc.CreateComment("My comment for Element1")
        ChildNode.appendChild newComment
        
        Set New_ChildNode = xDoc.createElement("Element2")
        New_ChildNode.Text = i
        ChildNode.appendChild New_ChildNode
        
        Set newComment = xDoc.CreateComment("My comment for Element2")
        ChildNode.appendChild newComment
        
        Set New_ChildNode = xDoc.createElement("Element3")
        New_ChildNode.Text = i
        ChildNode.appendChild New_ChildNode
        
        Set newComment = xDoc.CreateComment("My comment for Element3")
        ChildNode.appendChild newComment
    Next
    
    tempFileName = "Test"
    XML_FileName = ThisWorkbook.Path & Application.PathSeparator & tempFileName & ".xml"
    xDoc.Save XML_FileName
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(XML_FileName, ForReading)
    strXML = objFile.readall
    
    Set xmlWriter = CreateObject("MSXML2.MXXMLWriter")
    xmlWriter.omitXMLDeclaration = True
    xmlWriter.indent = True
    xmlWriter.Encoding = "utf-8"
    
    With CreateObject("MSXML2.SAXXMLReader")
        Set .contentHandler = xmlWriter
        .putProperty "http://xml.org/sax/properties/lexical-handler", xmlWriter
        .Parse strXML
    End With
    
    strOutput = xmlWriter.output
    Debug.Print strOutput
    
    Set objTextFile = objFSO.CreateTextFile(ThisWorkbook.Path & Application.PathSeparator & "myXML.txt")
    objTextFile.WriteLine strOutput
    objTextFile.Close
    
    Set objTextFile = Nothing
    Set xmlWriter = Nothing
    Set objFSO = Nothing
    Set myNode = Nothing
    Set New_ChildNode = Nothing
    Set ChildNode = Nothing
    Set objRoot = Nothing
    Set xDoc = Nothing
End Sub

.

Note: You may use xmlWriter.omitXMLDeclaration = False to add the XML declaration in top of the body created in the text file.

.

Screenshot of the XML file:

.

Screenshot of the text file: