DEVHIDE
Login Or Sign up

Adjust export script (excel->XML) to combine nodes under parent

79 Views Asked by At

How do I export my xml file as per the example using the data generated from Excel below: [sample input data](https://i.stack.imgur.com/hz68v.png)enter image description here

Below is my xml of data exported from excel using the existing script:

`<notaFiscal numOrdemNota="5">
    <chaveNFe>35231207282716000178550020000330341181635180</chaveNFe>
    <reconheceNFe>S</reconheceNFe>
    <numItens>3</numItens>
    <produtos>
       <numItemNFe>1</numItemNFe>
       <codInternoProduto>LA0690</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>28417020</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>30,6</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>4,6237</valorImpostoDeclarado>
    </produtos>
</notaFiscal>
    <notaFiscal numOrdemNota="5">
    <chaveNFe>35231207282716000178550020000330341181635180</chaveNFe>
    <reconheceNFe>S</reconheceNFe>
    <numItens>3</numItens>
    <produtos>
       <numItemNFe>2</numItemNFe>
       <codInternoProduto>LA0369</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>28011000</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>93,2</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>14,0825</valorImpostoDeclarado>
    </produtos>
</notaFiscal>
    <notaFiscal numOrdemNota="5">
    <chaveNFe>35231207282716000178550020000330341181635180</chaveNFe>
    <reconheceNFe>S</reconheceNFe>
    <numItens>3</numItens>
    <produtos>
       <numItemNFe>3</numItemNFe>
       <codInternoProduto>LA0691</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>38249941</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>160,2</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>24,2062</valorImpostoDeclarado>
    </produtos>
</notaFiscal>

Below is an example of how I want the XML to export (combine all produtos under single notaFiscal):

<notaFiscal numOrdemNota="5">
    <chaveNFe>35231207282716000178550020000330341181635180</chaveNFe>
    <reconheceNFe>S</reconheceNFe>
    <numItens>3</numItens>
    <produtos>
       <numItemNFe>1</numItemNFe>
       <codInternoProduto>LA0690</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>28417020</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>30,6</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>4,6237</valorImpostoDeclarado>
    </produtos>
    <produtos>
       <numItemNFe>2</numItemNFe>
       <codInternoProduto>LA0369</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>28011000</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>93,2</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>14,0825</valorImpostoDeclarado>
    </produtos>
    <produtos>
       <numItemNFe>3</numItemNFe>
       <codInternoProduto>LA0691</codInternoProduto>
       <indiceCodGeralProduto>1</indiceCodGeralProduto>
       <codGeralProduto>38249941</codGeralProduto>
       <codTipoTributacao>A012</codTipoTributacao>
       <valorBaseCalculoItem>160,2</valorBaseCalculoItem>
       <valorMultiplicador>0,1511</valorMultiplicador>
       <valorImpostoDeclarado>24,2062</valorImpostoDeclarado>
   </produtos>
 </notaFiscal>
`

Below are the VBA codes used to export the xml file:

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 DiaAtributos As IXMLDOMAttribute, Atributos As IXMLDOMAttribute, NFatributos As IXMLDOMAttribute
Dim Reconhecer As IXMLDOMElement, ValorBs As IXMLDOMElement, chave As IXMLDOMElement, NumNotas As IXMLDOMElement
Dim NumItens As IXMLDOMElement, Produtos As IXMLDOMElement, NumItemNFe As IXMLDOMElement
Dim CodInterno As IXMLDOMElement, IndGeral As IXMLDOMElement, IndGeralProdutos As IXMLDOMElement
Dim TipoTributação As IXMLDOMElement, Multiplicador As IXMLDOMElement, ValorImposto As IXMLDOMElement
Dim NumeroAtributo As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
Dim IE As IXMLDOMElement, Ano As IXMLDOMElement, Mes As IXMLDOMElement, Nome As IXMLDOMElement, Fone As IXMLDOMElement, Email As IXMLDOMElement
Dim ListaNF As IXMLDOMElement, NF As IXMLDOMElement
Dim nmsp As String
Dim g As Long
    

    ' NODE PAI '
    nmsp = "http://www.sefaz.am.gov.br/autodesembaraco"
    
    Set root = doc.createNode(NODE_ELEMENT, "enviDeclaracaoAutodesembaraco", nmsp)
    doc.appendChild root
    
    Set DiaAtributos = doc.createAttribute("xsischemaLocation")
    DiaAtributos.Value = "http://www.sefaz.am.gov.br/autodesembaracoenviDeclaracaoMensalAuto_v1.02.xsd"
    root.Attributes.setNamedItem DiaAtributos
    
    Set ItemNode = doc.createElement("infDeclaracaoMensal")
    root.appendChild ItemNode
    
    Set Atributos = doc.createAttribute("versao")
    Atributos.Value = "01"
    ItemNode.Attributes.setNamedItem Atributos
    
    Set IE = doc.createElement("ieContribuinteDeclarante")
    IE.Text = Range("b2").Value
    ItemNode.appendChild IE

    Set Ano = doc.createElement("anoApresentacao")
    Ano.Text = Range("c2").Value
    ItemNode.appendChild Ano

    Set Mes = doc.createElement("mesApresentacao")
    Mes.Text = Range("d2").Value
    ItemNode.appendChild Mes
    
    Set Nome = doc.createElement("nomeResponsavel")
    Nome.Text = Range("e2").Value
    ItemNode.appendChild Nome

    Set Fone = doc.createElement("foneResponsavel")
    Fone.Text = Range("f2").Value
    ItemNode.appendChild Fone
    
    Set Email = doc.createElement("emailResponsavel")
    Email.Text = Range("g2").Value
    ItemNode.appendChild Email
    
    Set ListaNF = doc.createElement("listaNotasFiscais")
    ItemNode.appendChild ListaNF
    
    
For g = 2 To Sheets(1).UsedRange.Rows.Count
    
    Set NF = doc.createElement("notaFiscal")
    ListaNF.appendChild NF
    
    Set NFatributos = doc.createAttribute("numOrdemNota")
    NFatributos.Value = Range("h" & g)
    NF.setAttributeNode NFatributos
    
    Set chave = doc.createElement("chaveNFe")
    chave.Text = Range("j" & g).Value
    NF.appendChild chave
     
    Set Reconhecer = doc.createElement("reconheceNFe")
    Reconhecer.Text = Range("k" & g)
    NF.appendChild Reconhecer
    
    Set NumItens = doc.createElement("numItens")
    NumItens.Text = Range("l" & g)
    NF.appendChild NumItens

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

    Set Produtos = doc.createElement("produtos")
    NF.appendChild Produtos

    Set NumItemNFe = doc.createElement("numItemNFe")
    NumItemNFe.Text = Range("n" & g)
    Produtos.appendChild NumItemNFe

    Set CodInterno = doc.createElement("codInternoProduto")
    CodInterno.Text = Range("o" & g)
    Produtos.appendChild CodInterno

    Set IndGeral = doc.createElement("indiceCodGeralProduto")
    IndGeral.Text = Range("p" & g)
    Produtos.appendChild IndGeral
    
    Set IndGeralProdutos = doc.createElement("codGeralProduto")
    IndGeralProdutos.Text = Range("q" & g)
    Produtos.appendChild IndGeralProdutos
    
    Set TipoTributação = doc.createElement("codTipoTributacao")
    TipoTributação.Text = Range("r" & g)
    Produtos.appendChild TipoTributação
    
    Set ValorBs = doc.createElement("valorBaseCalculoItem")
    ValorBs.Text = Range("s" & g)
    Produtos.appendChild ValorBs
    
    Set Multiplicador = doc.createElement("valorMultiplicador")
    Multiplicador.Text = Range("t" & g)
    Produtos.appendChild Multiplicador
    
    Set ValorImposto = doc.createElement("valorImpostoDeclarado")
    ValorImposto.Text = Range("u" & g)
    Produtos.appendChild ValorImposto
    
        
Next g

    Set NumNotas = doc.createElement("numNotasArquivo")
    NumNotas.Text = Range("v2").Value
    ItemNode.appendChild NumNotas

    
       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 used to export Excel data xml file

Thanks for your attention, have a great day

excel xml vba vba7 vba6
Original Q&A
1

There are 1 best solutions below

2
Denton Thomas On

Try this. I made three changes that will get you very close, but I cannot be certain without a complete input data sample. I don't know how the sample data lines up with the columns in the script you provided. This may not be something anyone can solve unless you provide a more complete input data sample.

I added two counters:

Dim g As Long, prodCounter As Long, itemCounter As

Then I used those to hold off closing the parent until all items are processed (I took the item counter from the right field, yes? My Portuguese is not so good!):

    ' counters: only append parent details when finished with all products
    prodCounter = 0
    itemCounter = 0
    
For g = 2 To Sheets(1).UsedRange.Rows.Count
    
    If prodCounter = itemCounter Then
    
        Set NF = doc.createElement("notaFiscal")
        ListaNF.appendChild NF
        
        Set NFatributos = doc.createAttribute("numOrdemNota")
        NFatributos.Value = Range("h" & g)
        NF.setAttributeNode NFatributos
        
        Set chave = doc.createElement("chaveNFe")
        chave.Text = Range("j" & g).Value
        NF.appendChild chave
         
        Set Reconhecer = doc.createElement("reconheceNFe")
        Reconhecer.Text = Range("k" & g)
        NF.appendChild Reconhecer
        
        Set NumItens = doc.createElement("numItens")
        NumItens.Text = Range("l" & g)
        NF.appendChild NumItens
        
        itemCounter = Range("l" & g).Value
    
    End If
    prodCounter = prodCounter + 1

And I also made your file save line dynamic. Maybe helps move the file amongst users with less pain ...

newDoc.Save baseDirectory & projectName & "C:\Users\" & Environ("username") & "\Downloads\DIA.xml"

Here is the complete script.

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 DiaAtributos As IXMLDOMAttribute, Atributos As IXMLDOMAttribute, NFatributos As IXMLDOMAttribute
Dim Reconhecer As IXMLDOMElement, ValorBs As IXMLDOMElement, chave As IXMLDOMElement, NumNotas As IXMLDOMElement
Dim NumItens As IXMLDOMElement, Produtos As IXMLDOMElement, NumItemNFe As IXMLDOMElement
Dim CodInterno As IXMLDOMElement, IndGeral As IXMLDOMElement, IndGeralProdutos As IXMLDOMElement
Dim TipoTributação As IXMLDOMElement, Multiplicador As IXMLDOMElement, ValorImposto As IXMLDOMElement
Dim NumeroAtributo As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
Dim IE As IXMLDOMElement, Ano As IXMLDOMElement, Mes As IXMLDOMElement, Nome As IXMLDOMElement, Fone As IXMLDOMElement, Email As IXMLDOMElement
Dim ListaNF As IXMLDOMElement, NF As IXMLDOMElement
Dim nmsp As String
Dim g As Long, prodCounter As Long, itemCounter As Long
    

    ' NODE PAI / parent node'
    nmsp = "http://www.sefaz.am.gov.br/autodesembaraco"
    
    Set root = doc.createNode(NODE_ELEMENT, "enviDeclaracaoAutodesembaraco", nmsp)
    doc.appendChild root
    
    Set DiaAtributos = doc.createAttribute("xsischemaLocation")
    DiaAtributos.Value = "http://www.sefaz.am.gov.br/autodesembaracoenviDeclaracaoMensalAuto_v1.02.xsd"
    root.Attributes.setNamedItem DiaAtributos
    
    Set ItemNode = doc.createElement("infDeclaracaoMensal")
    root.appendChild ItemNode
    
    Set Atributos = doc.createAttribute("versao")
    Atributos.Value = "01"
    ItemNode.Attributes.setNamedItem Atributos
    
    Set IE = doc.createElement("ieContribuinteDeclarante")
    IE.Text = Range("b2").Value
    ItemNode.appendChild IE

    Set Ano = doc.createElement("anoApresentacao")
    Ano.Text = Range("c2").Value
    ItemNode.appendChild Ano

    Set Mes = doc.createElement("mesApresentacao")
    Mes.Text = Range("d2").Value
    ItemNode.appendChild Mes
    
    Set Nome = doc.createElement("nomeResponsavel")
    Nome.Text = Range("e2").Value
    ItemNode.appendChild Nome

    Set Fone = doc.createElement("foneResponsavel")
    Fone.Text = Range("f2").Value
    ItemNode.appendChild Fone
    
    Set Email = doc.createElement("emailResponsavel")
    Email.Text = Range("g2").Value
    ItemNode.appendChild Email
    
    Set ListaNF = doc.createElement("listaNotasFiscais")
    ItemNode.appendChild ListaNF
    
    
    prodCounter = 0
    itemCounter = 0
    
For g = 2 To Sheets(1).UsedRange.Rows.Count
    
    If prodCounter = itemCounter Then
    
        Set NF = doc.createElement("notaFiscal")
        ListaNF.appendChild NF
        
        Set NFatributos = doc.createAttribute("numOrdemNota")
        NFatributos.Value = Range("h" & g)
        NF.setAttributeNode NFatributos
        
        Set chave = doc.createElement("chaveNFe")
        chave.Text = Range("j" & g).Value
        NF.appendChild chave
         
        Set Reconhecer = doc.createElement("reconheceNFe")
        Reconhecer.Text = Range("k" & g)
        NF.appendChild Reconhecer
        
        Set NumItens = doc.createElement("numItens")
        NumItens.Text = Range("l" & g)
        NF.appendChild NumItens
        
        itemCounter = Range("l" & g).Value
    
    End If
    prodCounter = prodCounter + 1

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

    Set Produtos = doc.createElement("produtos")
    NF.appendChild Produtos

    Set NumItemNFe = doc.createElement("numItemNFe")
    NumItemNFe.Text = Range("n" & g)
    Produtos.appendChild NumItemNFe

    Set CodInterno = doc.createElement("codInternoProduto")
    CodInterno.Text = Range("o" & g)
    Produtos.appendChild CodInterno

    Set IndGeral = doc.createElement("indiceCodGeralProduto")
    IndGeral.Text = Range("p" & g)
    Produtos.appendChild IndGeral
    
    Set IndGeralProdutos = doc.createElement("codGeralProduto")
    IndGeralProdutos.Text = Range("q" & g)
    Produtos.appendChild IndGeralProdutos
    
    Set TipoTributação = doc.createElement("codTipoTributacao")
    TipoTributação.Text = Range("r" & g)
    Produtos.appendChild TipoTributação
    
    Set ValorBs = doc.createElement("valorBaseCalculoItem")
    ValorBs.Text = Range("s" & g)
    Produtos.appendChild ValorBs
    
    Set Multiplicador = doc.createElement("valorMultiplicador")
    Multiplicador.Text = Range("t" & g)
    Produtos.appendChild Multiplicador
    
    Set ValorImposto = doc.createElement("valorImpostoDeclarado")
    ValorImposto.Text = Range("u" & g)
    Produtos.appendChild ValorImposto
        
Next g

    Set NumNotas = doc.createElement("numNotasArquivo")
    NumNotas.Text = Range("v2").Value
    ItemNode.appendChild NumNotas

    
       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\" & Environ("username") & "\Downloads\DIA.xml"
    
    MsgBox "Arquivo XML gerado com sucesso!", vbInformation
    Exit Sub

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

End Sub

Related Questions in EXCEL

Related Questions in XML

Related Questions in VBA

Related Questions in VBA7

Related Questions in VBA6

Trending Questions

Popular # Hahtags

javascript python java c# php android html jquery c++ css ios sql mysql r reactjs

Popular Questions

.

Copyright © 2021 Jogjafile Inc.