Macro VBA Excel create XML file date

Question

With a Macro VBA in Excel, I need to convert date on 1 sheet in an excel file. For this, I have already created a script but I have a problem to generate correctly the date in an XML I need the first line a header and then a formula read all rows with data.

 Sub createXML()

Sheets("Sheet1").Select

    FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Charset = "iso-8859-1"

    objStream.Open
    objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf)
    objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf)
    objStream.WriteText ("  <y:datas>" & vbLf)
    objStream.WriteText ("      <y:instance yid='theGeneralData'>" & vbLf)
    objStream.WriteText ("" & vbLf)

    objStream.WriteText ("<language yid='LANG_en' />" & vbLf)

    objStream.WriteText ("<client yclass='Client'>" & vbLf)
    objStream.WriteText ("  <firstName>" & Cells(1, 1).Text & "</firstName>" & vbLf)
    objStream.WriteText ("  <lastName>" & Cells(1, 2).Text & "</lastName>" & vbLf)
    objStream.WriteText ("  <age>" & Cells(1, 3).Text & "</age>" & vbLf)
    objStream.WriteText ("  <civility yid='" & toYID(Cells(1, 4).Text) & "' />" & vbLf)
    objStream.WriteText ("</client>" & vbLf)

    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("      </y:instance>" & vbLf)
    objStream.WriteText ("  </y:datas>" & vbLf)
    objStream.WriteText ("</y:input>" & vbLf)               
    objStream.SaveToFile FullPath, 2
    objStream.Close   
End Sub

the excel data now are in this format:

enter image description here

But my output for now are this:

> <?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>

<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>   
      </y:instance>
  </y:datas>
</y:input>

We need to have this output:

> <?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>

<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>1</firstName>
  <lastName>1</lastName>
  <age>1</age>
  <civility yid='CIVILITY' />
</client>
<client yclass='Client'>
  <firstName>2</firstName>
  <lastName>2</lastName>
  <age>2</age>
  <civility yid='CIVILITY' />
</client>
<client yclass='Client'>
  <firstName>3</firstName>
  <lastName>3</lastName>
  <age>3</age>
  <civility yid='CIVILITY' />
</client>
      </y:instance>
  </y:datas>
</y:input>

Answer 1

Consider using MSXML , a comprehensive W3C compliant library of XML APIs which you can use to build your XML with DOM properties ( createElement , setAttribute ) instead of concatenating text strings. XML is not quite a text file but a markup file with encoding and tree structure. VBA comes equipped with the MSXML object and can iteratively build a tree from Excel data as shown below:

Excel data

FirstName   LastName    Age    Civility
Aaron       Adams       45     CIVILITY
Beatrice    Beaumont    39     CIVILITY
Clark       Chandler    28     CIVILITY
Debra       Devins      31     CIVILITY
Eric        Easterlin   42     CIVILITY

VBA Macro (builds XML tree and then pretty prints with XSLT)

Sub xmlExport()
On Error GoTo ErrHandle
    ' ADD Microsoft XML, v6.0 IN VBA References
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
    Dim root As IXMLDOMNode, ydatasNode As IXMLDOMNode, yinstanceNode As IXMLDOMNode, languageNode As IXMLDOMElement
    Dim yinstanceAttrib As IXMLDOMAttribute, languageAttrib As IXMLDOMAttribute
    Dim clientNode As IXMLDOMElement, civilityNode As IXMLDOMElement
    Dim firstNameNode As IXMLDOMElement, lastNameNode As IXMLDOMElement, ageNode As IXMLDOMElement
    Dim clientAttrib As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
    Dim nmsp As String
    Dim i As Long

    ' DECLARE ROOT AND CHILDREN '
    nmsp = "http://www.test.com/engine/3"
    Set root = doc.createNode(NODE_ELEMENT, "y:input", nmsp)
    doc.appendChild root

    Set ydatasNode = doc.createNode(NODE_ELEMENT, "y:datas", nmsp)
    root.appendChild ydatasNode

    Set yinstanceNode = doc.createNode(NODE_ELEMENT, "y:instance", nmsp)
    ydatasNode.appendChild yinstanceNode
    Set yinstanceAttrib = doc.createAttribute("yid")
    yinstanceAttrib.Value = "theGeneralData"
    yinstanceNode.Attributes.setNamedItem yinstanceAttrib

    Set languageNode = doc.createElement("language")
    yinstanceNode.appendChild languageNode
    Set languageAttrib = doc.createAttribute("yid")
    languageAttrib.Value = "LANG_en"
    languageNode.setAttributeNode languageAttrib

    ' ITERATE CLIENT NODES '
    For i = 2 To Sheets(1).UsedRange.Rows.Count

        ' CLIENT NODE '
        Set clientNode = doc.createElement("client")
        yinstanceNode.appendChild clientNode

        Set clientAttrib = doc.createAttribute("yclass")
        clientAttrib.Value = "Client"
        clientNode.setAttributeNode clientAttrib

        ' FIRST NAME NODE '
        Set firstNameNode = doc.createElement("firstName")
        firstNameNode.Text = Range("A" & i)
        clientNode.appendChild firstNameNode

        ' LAST NAME NODE '
        Set lastNameNode = doc.createElement("lastName")
        lastNameNode.Text = Range("B" & i)
        clientNode.appendChild lastNameNode

        ' AGE NODE '
        Set ageNode = doc.createElement("age")
        ageNode.Text = Range("C" & i)
        clientNode.appendChild ageNode

        ' CIVILITY NODE '
        Set civilityNode = doc.createElement("civility")
        clientNode.appendChild civilityNode
        Set civilityAttrib = doc.createAttribute("yid")
        civilityAttrib.Value = toYID(Range("D" & i))
        civilityNode.setAttributeNode civilityAttrib

    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 baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    MsgBox "Successfully exported Excel data to XML!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub

End Sub

Output

<?xml version="1.0" encoding="UTF-8"?>
<y:input xmlns:y="http://www.test.com/engine/3">
    <y:datas>
        <y:instance yid="theGeneralData">
            <language yid="LANG_en"></language>
            <client yclass="Client">
                <firstName>Aaron</firstName>
                <lastName>Adams</lastName>
                <age>45</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Beatrice</firstName>
                <lastName>Beaumont</lastName>
                <age>39</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Clark</firstName>
                <lastName>Chandler</lastName>
                <age>28</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Debra</firstName>
                <lastName>Devins</lastName>
                <age>31</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Eric</firstName>
                <lastName>Easterlin</lastName>
                <age>42</age>
                <civility yid="CIVILITY"></civility>
            </client>
        </y:instance>
    </y:datas>
</y:input>

Answer 2

The way you have your code setup, all it does is look at first row. You need to add a loop for it to look through all your rows (I'm presuming that you have 'n' number of rows). To do this, you can first get the row count by using something like:

Dim intTotalRows as Integer : intTotalRows = Worksheets("<your worksheet name>").Cells(Rows.Count, "B").End(xlUp).Row

Now that you have your row count, add a FOR loop just before objStream.WriteText ("<client yclass='Client'>" & vbLf) and finish it after objStream.WriteText ("</client>" & vbLf) . This will loop through all your rows. Your FOR loop could look something like:

For intRow = 1 To intTotalRows 

Now change your row number with intRow . ie:

objStream.WriteText ("  <firstName>" & Cells(intRow, 1).Text & "</firstName>" & vbLf)
objStream.WriteText ("  <lastName>" & Cells(intRow, 2).Text & "</lastName>" & vbLf)

Hope this helps

Answer 3

here the output

<?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
      </y:instance>
  </y:datas>
</y:input>

and here my script:

Sub createXML()

    Sheets("Sheet1").Select

    FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Charset = "iso-8859-1"

    objStream.Open
    objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf)
    objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf)
    objStream.WriteText ("  <y:datas>" & vbLf)
    objStream.WriteText ("      <y:instance yid='theGeneralData'>" & vbLf)
    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("<language yid='LANG_en' />" & vbLf)
    Dim intTotalRows As Integer: intTotalRows = Worksheets("Sheet1").Cells(Rows.Count, "B").End(x1Up).Row
    For intRow = 1 To intTotalRows
    objStream.WriteText ("<client yclass='Client'>" & vbLf)
    objStream.WriteText ("  <firstName>" & Cells(1).Text & "</firstName>" & vbLf)
    objStream.WriteText ("  <lastName>" & Cells(2).Text & "</lastName>" & vbLf)
    objStream.WriteText ("  <age>" & Cells(3).Text & "</age>" & vbLf)
    objStream.WriteText ("  <civility yid='" & toYID(Cells(4).Text) & "' />" & vbLf)
    objStream.WriteText ("</client>" & vbLf)
    Next intRow
    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("      </y:instance>" & vbLf)
    objStream.WriteText ("  </y:datas>" & vbLf)
    objStream.WriteText ("</y:input>" & vbLf)

    objStream.SaveToFile FullPath, 2
    objStream.Close

End Sub

Thanks a lot