使用 VBA 将属性放入 XML 文件中

Question

如何将属性放在我的 vba 代码中的节点

envideclaracaoautodesembaraco

中。我希望我的

.xml

文件生成与下面的示例相同的属性。

<enviDeclaracaoAutodesembaraco 
      xmlns="http://www.sefaz.am.gov.br/autodesembaraco" 
      xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 
      xsi:schemaLocation="http://www.sefaz.am.gov.br/autodesembaraco enviDeclaracaoMensalAuto_v1.02.xsd">
   <infDeclaracaoMensal versao="01">
      <ieContribuinteDeclarante>063010712</ieContribuinteDeclarante>
      <anoApresentacao>2024</anoApresentacao>
      <mesApresentacao>01</mesApresentacao>
      <nomeResponsavel>RAI RODRIGUES</nomeResponsavel>
      <foneResponsavel>0000000000</foneResponsavel>
      <emailResponsavel>[email protected]</emailResponsavel>`
      ...snip...

xml文件中的属性图片：

下面是我在 vba 中导出 xml 文件的代码：

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.createElement("enviDeclaracaoAutodesembaraco")
    doc.appendChild root
    
    Set DiaAtributos = doc.createAttribute("xsischemaLocation")
    DiaAtributos.Value = "http://www.sefaz.am.gov.br/autodesembaraco enviDeclaracaoMensalAuto_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
 
    NumeroItemNfe = Cells(g, 15)
 
 If NumeroItemNfe = 1 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)
    NF.appendChild chave
    
    Set Reconhecer = doc.createElement("reconheceNFe")
    Reconhecer.Text = Range("L" & g)
    NF.appendChild Reconhecer
    
    Set NumItens = doc.createElement("numItens")
    NumItens.Text = Range("M" & g)
    NF.appendChild NumItens
    
    'Else
    
    'GoTo ProximaInteracao
    
    End If
    
'ProximaInteracao:

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

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

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

    Set IndGeral = doc.createElement("indiceCodGeralProduto")
    IndGeral.Text = Range("Q" & g)
    Produtos.appendChild IndGeral

    Set IndGeralProdutos = doc.createElement("codGeralProduto")
    IndGeralProdutos.Text = Range("R" & g)
    Produtos.appendChild IndGeralProdutos
    
    Set TipoTributação = doc.createElement("codTipoTributacao")
    TipoTributação.Text = Range("S" & g)
    Produtos.appendChild TipoTributação
    
    Set ValorBs = doc.createElement("valorBaseCalculoItem")
    ValorBs.Text = Replace(Format(Range("T" & g), "0.00"), ",", ".")
    Produtos.appendChild ValorBs
    
    Set Multiplicador = doc.createElement("valorMultiplicador")
    Multiplicador.Text = Replace(Format(Range("U" & g), "0.00"), ",", ".")
    Produtos.appendChild Multiplicador
    
    Set ValorImposto = doc.createElement("valorImpostoDeclarado")
    ValorImposto.Text = Replace(Format(Range("V" & g), "0.00"), ",", ".")
    Produtos.appendChild ValorImposto
    
Next g

    Set NumNotas = doc.createElement("numNotasArquivo")
    NumNotas.Text = Range("W2").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

以上 Visual Basic for application 中的代码导出 Excel 数据 xml 文件。

Answer 1

我认为您遇到的主要问题是将属性添加到根元素：

• xmlns="http://www.sefaz.am.gov.br/autodesembaraco" 

• xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"

• xsi:schemaLocation="http://www.sefaz.am.gov.br/autodesembaraco enviDeclaracaoMensalAuto_v1.02.xsd"

问题在于如何创建命名空间架构位置：

Dim doc As New MSXML2.DOMDocument60
Dim root As IXMLDOMNode
Dim nmsp As String, xsi As String, schemaLocation As String

' namespaces and schema location
nmsp = "http://www.sefaz.am.gov.br/autodesembaraco"
xsi = "http://www.w3.org/2001/XMLSchema-instance"
schemaLocation = "http://www.sefaz.am.gov.br/autodesembaraco enviDeclaracaoMensalAuto_v1.02.xsd"

1. 通过传递命名空间来创建根元素：

' Create the root element - with namespace - by using createNode (NODE_ELEMENT = 1)
Set root = doc.createNode(NODE_ELEMENT, "enviDeclaracaoAutodesembaraco", nmsp)
doc.appendChild root

2. 声明

   xsi

   命名空间：

' Add xmlns:xsi attribute
Set xsiAttr = doc.createAttribute("xmlns:xsi")
xsiAttr.Value = xsi
root.Attributes.setNamedItem xsiAttr

3. 添加

   schemaLocation

   ：

' Add xsi:schemaLocation attribute
Set schemaLocationAttr = doc.createAttribute("xsi:schemaLocation")
schemaLocationAttr.Value = schemaLocation