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

  • 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