Search code examples
excelxmlvbavba7vba6

Create an XML file using spreadsheet data with Visual Basic

The VBA codes generate an xml file as per the model below:

<Produtos xmlns="http://www.test.com/engine/3">
  <Item_1>
    <UF xmlns="" yid="1">AM</UF>
    <Chave xmlns="" yclass="Numero">
     13210304807608000183550010000375501641176337'
       <Numero>37550</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>884</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>883</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>882</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>881</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
    </Chave>
    <UF xmlns="" yid="1">AM</UF>
    <Chave xmlns="" yclass="Numero">
   '13210304807608000183550030000008841547448234'
       <Numero>37550</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>884</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>883</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>882</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>881</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
    </Chave>
    <UF xmlns="" yid="1">AM</UF>
    <Chave xmlns="" yclass="Numero">
    '13210304807608000183550030000008831185218530'
       <Numero>37550</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>884</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>883</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>882</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>881</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
    </Chave>
    <UF xmlns="" yid="1">AM</UF>
    <Chave xmlns="" yclass="Numero">
    '13210304807608000183550030000008821762935344'
       <Numero>37550</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>884</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>883</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>882</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>881</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
    </Chave>
    <UF xmlns="" yid="1">AM</UF>
    <Chave xmlns="" yclass="Numero">
    '13210304807608000183550030000008811866416605'
       <Numero>37550</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>884</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>883</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>882</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
       <Numero>881</Numero>
       <Emissao>31/03/2021</Emissao>
       <CFOP>5905</CFOP>
       <Tipo>SAÍDA</Tipo>
       <Valor>134897,4</Valor>
    </Chave>
  </Item_1>
 </Produtos>

Using Excel data as shown in the image: enter image description here

Below I have the codes that are generating the xml file above:

Sub xmlExport()

'On Error GoTo ErrHandle
    
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
    Dim root As IXMLDOMNode, ItemNode As IXMLDOMNode, yinstanceNode As IXMLDOMNode, UFNode As IXMLDOMElement
    Dim yinstanceAttrib As IXMLDOMAttribute, Atributos As IXMLDOMAttribute
    Dim NumeroNode As IXMLDOMElement, ValorNode As IXMLDOMElement, chave As IXMLDOMElement
    Dim EmissãoNode As IXMLDOMElement, CFOPNode As IXMLDOMElement, TipoNode As IXMLDOMElement
    Dim NumeroAtributo As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
    Dim nmsp As String
    Dim i As Long
    Dim g As Long
    

    ' NODE PAI '
    nmsp = "http://www.test.com/engine/3"
    Set root = doc.createNode(NODE_ELEMENT, "Produtos", nmsp)
    doc.appendChild root

    Set ItemNode = doc.createNode(NODE_ELEMENT, "Item_1", nmsp)
    root.appendChild ItemNode


For g = 2 To Sheets(1).UsedRange.Rows.Count

    Set UFNode = doc.createElement("UF")
    UFNode.Text = Range("a" & g)
    ItemNode.appendChild UFNode
    
    Set Atributos = doc.createAttribute("yid")
    Atributos.Value = "1"
    UFNode.setAttributeNode Atributos
    
    Set chave = doc.createElement("Chave")
    chave.Text = Range("b" & g)
    ItemNode.appendChild chave
    

    ' NODE FILHOS '
    
    For i = 2 To Sheets(1).UsedRange.Rows.Count
        
        Set NumeroNode = doc.createElement("Numero")
        NumeroNode.Text = Range("c" & i)
        chave.appendChild NumeroNode

        Set NumeroAtributo = doc.createAttribute("yclass")
        NumeroAtributo.Value = "Numero"
        chave.setAttributeNode NumeroAtributo

        Set EmissãoNode = doc.createElement("Emissao")
        EmissãoNode.Text = Range("E" & i)
        chave.appendChild EmissãoNode

        Set CFOPNode = doc.createElement("CFOP")
        CFOPNode.Text = Range("i" & i)
        chave.appendChild CFOPNode

        Set TipoNode = doc.createElement("Tipo")
        TipoNode.Text = Range("k" & i)
        chave.appendChild TipoNode

        Set ValorNode = doc.createElement("Valor")
        ValorNode.Text = Range("l" & i)
        chave.appendChild ValorNode
        

Next i
  
Next g

    
    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 & "C:\Users\rai\Downloads\DIA.xml"
    
    

    MsgBox "Arquivo XML gerado com sucesso!", vbInformation
    Exit Sub

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

End Sub

Above are the VBA codes to export xml file through excel data.

Could anyone help me export an xml file with Excel data as per the model below:

<Produtos/>
  <Item_1/>
     <UF> AM </UF>
     <CHAVE> 13210304807608000183550010000375501641176337'
        <NUMERO> 37550 </NUMERO>
        <EMISSÃO> 31.03.2021 </EMISSÃO>
        <CFOP> 5905 </CFOP>
        <TIPO> SAIDA </TIPO>
        <VALOR> 134897,40 </VALOR>
     </CHAVE>
     <UF> AM </UF>
     <CHAVE> '13210304807608000183550030000008841547448234'
        <NUMERO> 884 </NUMERO>
        <EMISSÃO> 31.03.2021 </EMISSÃO>
        <CFOP> 5905 </CFOP>
        <TIPO> SAIDA </TIPO>
        <VALOR> 134897,40 </VALOR>
     </CHAVE>
     <UF> AM </UF>
     <CHAVE> '13210304807608000183550030000008831185218530'
        <NUMERO> 883 </NUMERO>
        <EMISSÃO> 31.03.2021 </EMISSÃO>
        <CFOP> 5905 </CFOP>
        <TIPO> SAIDA </TIPO>
        <VALOR> 134897,40 </VALOR>  
     </CHAVE>
     <UF> AM </UF>
     <CHAVE> '13210304807608000183550030000008821762935344'
        <NUMERO> 882 </NUMERO>
        <EMISSÃO> 31.03.2021 </EMISSÃO>
        <CFOP> 5905 </CFOP>
        <TIPO> SAIDA </TIPO>
        <VALOR> 134897,40 </VALOR>
     </CHAVE>
     <UF> AM </UF>
     <CHAVE> '13210304807608000183550030000008811866416605'
        <NUMERO> 881 </NUMERO>
        <EMISSÃO> 31.03.2021 </EMISSÃO>
        <CFOP> 5905 </CFOP>
        <TIPO> SAIDA </TIPO>
        <VALOR> 134897,40 </VALOR>
  <Item_2/>
<Produtos/>

My goal is to generate an xml file according to the model above, I've tried everything but I can't.

Solution
    • The code in the original post unintentionally uses a nested loop, resulting in duplicated nodes under <Chave>.
    • Remove the code lines for AttributeNode.
    • Depending on your local number format, you may need to change Format(Range("L" & i), "0.00") to Format(Range("L" & i), "0,00").
    Sub xmlExport()
    On Error GoTo ErrHandle
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
    Dim root As IXMLDOMNode, ItemNode As IXMLDOMNode, yinstanceNode As IXMLDOMNode, UFNode As IXMLDOMElement
    Dim yinstanceAttrib As IXMLDOMAttribute, Atributos As IXMLDOMAttribute
    Dim NumeroNode As IXMLDOMElement, ValorNode As IXMLDOMElement, chave As IXMLDOMElement
    Dim EmissaoNode As IXMLDOMElement, CFOPNode As IXMLDOMElement, TipoNode As IXMLDOMElement
    Dim NumeroAtributo As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
    Dim nmsp As String
    Dim i As Long
    ' NODE PAI '
    '    nmsp = "http://www.test.com/engine/3"
    nmsp = ""
    Set root = doc.createNode(NODE_ELEMENT, "Produtos", nmsp)
    doc.appendChild root
    Set ItemNode = doc.createNode(NODE_ELEMENT, "Item_1", nmsp)
    root.appendChild ItemNode
    For i = 2 To Sheets(1).UsedRange.Rows.Count
        Set UFNode = doc.createElement("UF")
        UFNode.Text = Range("a" & i)
        ItemNode.appendChild UFNode
        Set chave = doc.createElement("CHAVE")
        chave.Text = Range("B" & i)
        ItemNode.appendChild chave
        Set NumeroNode = doc.createElement("NUMERO")
        NumeroNode.Text = Range("C" & i)
        chave.appendChild NumeroNode
        Set EmissaoNode = doc.createElement("EMISSÃO") 
        EmissaoNode.Text = Format(Range("E" & i), "dd.MM.yyyy")
        chave.appendChild EmissaoNode
        Set CFOPNode = doc.createElement("CFOP")
        CFOPNode.Text = Range("I" & i)
        chave.appendChild CFOPNode
        Set TipoNode = doc.createElement("TIPO")
        TipoNode.Text = Range("K" & i)
        chave.appendChild TipoNode
        Set ValorNode = doc.createElement("VALOR")
        ValorNode.Text = Format(Range("L" & i), "0.00")
        chave.appendChild ValorNode
    Next i
    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 & "C:\Users\rai\Downloads\DIA.xml"
    newDoc.Save "d:\temp\DIA.xml" ' for testing
    Debug.Print "Arquivo XML gerado com sucesso!", vbInformation
    Exit Sub
ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub
End Sub