Macro VBA Excel create XML file date

12,790

Solution 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>

Solution 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. i.e.:

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

Hope this helps

Share:
12,790
Massimiliano Mascoli
Author by

Massimiliano Mascoli

Updated on June 20, 2022

Comments

  • Massimiliano Mascoli
    Massimiliano Mascoli almost 2 years

    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>
    
  • Massimiliano Mascoli
    Massimiliano Mascoli over 7 years
    Hi Zac thank you. The structure xml is generate correctly but the data are the same for each client. I have done something wrong?
  • Zac
    Zac over 7 years
    and the results
  • Zac
    Zac over 7 years
    As I suspected, you didn't add intRow to your Cells. Have a look at the last bit of code in my answer. It gives you an example of how to change the Cells bit of code i.e. objStream.WriteText (" <firstName>" & Cells(intRow, 1).Text & "</firstName>" & vbLf)
  • Zac
    Zac over 7 years
    No problem, glad it worked. Please don't forget to accept the answer if it helped
  • Massimiliano Mascoli
    Massimiliano Mascoli over 7 years
    f i would to start to create all data in excel from row 4 how can i setup this? Also do you think is possible to have Client1, Client2 etc..?
  • Parfait
    Parfait over 7 years
    Change the loop entry: For i = 2 to For i = 4. And simply concatenate an iterator to client node name: Set clientNode = doc.createElement("client" & i - 3).