Prezados, boa tarde!
Meu nome é Marco, eu sou novo na área. Eu preciso de ajudar dos caros colegas.
Eu preciso importar vários arquivos xml em uma planilha do excel e depois gerar um relatório com as informações presentes no arquivo, tais como; valor, unidade de medida, ncm, alíquota.....
Por gentileza, alguém poderia me auxiliar nesse processo?
Desde já agradeço pela atenção.
Atenciosamente,
Marco
Olá,
Como eu faço para importar mais arquivos? Eu tentei mais não estou conseguindo. (aparece uma mensagem informando que a fonte de dados não está disponível)
Apenas um detalhe: Existem arquivos que possuem mais de um item.
Aguardo retorno o mais breve possível.
Mande esse arquivo que não está importando, ou mais de um.
Não tenho arquivos do tipo CFe para testar. Fiz o teste com o primeiro que você enviou e funcionou normalmente.
De acordo com a mensagem, penso que talvez esteja algo errado com o arquivo.
Bom,mande aqui que tentar achar algo.
Att,
MS
Em anexo, seguem os arquivos.
Eu mandei junto um documento no formato word (documento contém mais detalhes do que eu estou fazendo com imagens dos erros)
Atenciosamente,
Marco
Olá,
Alguém conseguiu?
Boa tarde.
Importei os 4 arquivos xml que enviou por último.
Segue planilha para tentar importar ai.
Att,
MS
Olá,
vou fazer o teste.
Atenciosamente,
Marco
Boa noite,
Veja se o arquivo que fiz pode te ajudar na importação do xml;
http://fabiomitsueda.com.br/importar-ar ... ara-excel/
Abraço
Fábio, boa tarde! Excelente planilha essa indicada ao usuário
Por favor, você (ou qualquer outro FERA do excel) poderia apenas acrescentar um campo nessa planilha?
no meu caso eu ia precisar de um campo chamado UNIDADE DE MEDIDA
A planilha importa vários dados do produto, porém a planilha não importa o campo unidade de medida, seria possível acrescentar esse campo ao código vba?
'Desenvolvido por Fabio Mitsueda 'http://fabiomitsueda.com.br 'Data da finalização 05/03/2018 Option Explicit 'Importante fazer referencia as dlls: 'Microsoft XML, v6.0 'Microsoft Scripting Runtime Sub PastaXml() 'Declaração de variaves de objeto a serem utilizadas para percorrer os arquivos na pasta selecionada Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objFile As Scripting.File 'Declarando variavel que será carregada com o nome do arquivo Dim strCaminho As String Dim i As Long With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then strCaminho = .SelectedItems(1) Set objFSO = New Scripting.FileSystemObject Set objFolder = objFSO.GetFolder(strCaminho) For Each objFile In objFolder.Files If objFSO.GetExtensionName(objFile.Path) = "xml" Then LerXml (strCaminho & "" & objFile.Name) i = i + 1 End If Next ' MsgBox "Processo Finalizado!!!" & vbCrLf & vbCrLf & _ '"Foi feita leitura de " & i & " arquivos XML", vbOKOnly End If End With Set objFSO = Nothing Set objFolder = Nothing Set objFile = Nothing End Sub Sub LerXml(ByVal strFolderPath As String) 'Declaração de variaveis de objeto para leitura do XML Dim xmlDoc As DOMDocument Dim xmlList As IXMLDOMNodeList Dim xmlNode As IXMLDOMNode 'Declaração de variaveis diversas para o código Dim shtXml As Worksheet Dim strXml As String Dim x, y, i As Long Dim objPasta As FileDialog 'Declaração de variaveis de retorno do XML Dim strVersao As String Dim strEmitente As String Dim strCNPJEmi As String Dim strIEEmite As String Dim strRegTrib As String Dim strNoNFe As String Dim strSerie As String Dim strDEmi As String Dim strChaveNFe As String Dim strCodProd As String Dim strDescric As String Dim strNCM As String Dim intCFOP As Integer Dim strEAN As String Dim strEANTrib As String Dim dblQtdCom As Double Dim dblQtdTri As Double Dim dblVlrCom As Double Dim dblVlrTri As Double Dim strVlrFrt As String Dim dblVlrFrt As Double Dim strVlrSeg As String Dim dblVlrSeg As Double Dim strVlrDes As String Dim dblVlrDes As Double Dim strVlrOut As String Dim dblVlrOut As Double Dim dblVlrTot As Double Dim strIcmsOr As String Dim strIcmsCst As String Dim strIcmsVlr As String Dim dblIcmsVlr As Double Dim strIcmsAlq As String Dim dblIcmsAlq As Double Dim strPisCST As String Dim strPisAlq As String Dim dblPisAlq As Double Dim strPisVlr As String Dim dblPisVlr As Double Dim strCofinCST As String Dim strCofinAlq As String Dim dblCofinAlq As Double Dim strCofinVlr As String Dim dblCofinVlr As Double Dim strIcmsBcSt As String Dim dblIcmsBcSt As Double Dim strIcmsStVr As String Dim dblIcmsStVr As Double Dim strIpiCST As String Dim strIpiVr As String Dim dblIpiVr As Double 'Atribuindo caminho do arquivo a variavel strXml = strFolderPath 'Carregando o objeto que irá representar o documento XML Set xmlDoc = New DOMDocument 'Carregando o arquivo xmlDoc.Load (strXml) 'Versão da NFE For i = 0 To xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes.Length - 1 If LCase(xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes(i).nodeName) = "versao" Then strVersao = xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes(i).NodeValue Exit For End If Next 'Leitura da Tag ide For Each xmlNode In xmlDoc.getElementsByTagName("ide") 'Verificar se o XML é Nfe pela existencia da Tag numero da nNF (número da nota) If xmlNode.SelectNodes("nNF").Length = 0 Then MsgBox "Não é um xml" Exit Sub End If 'Numero da nota fiscal strNoNFe = xmlNode.SelectNodes("nNF")(0).Text 'Série da nota fiscal strSerie = xmlNode.SelectNodes("serie")(0).Text 'Data de emissão Select Case strVersao Case "4.00" strDEmi = VBA.Format(VBA.Left(xmlNode.SelectNodes("dhEmi")(0).Text, 10), "dd/mm/yyyy") Case "3.10" strDEmi = VBA.Format(VBA.Left(xmlNode.SelectNodes("dhEmi")(0).Text, 10), "dd/mm/yyyy") Case Else strDEmi = VBA.Format(xmlNode.SelectNodes("dEmi")(0).Text, "dd/mm/yyyy") End Select Next 'Leitura da Tab emit (Emitente) For Each xmlNode In xmlDoc.getElementsByTagName("emit") 'Razão social do emitente strEmitente = xmlNode.SelectNodes("xNome")(0).Text 'CNPJ do emitente strCNPJEmi = "'" & xmlNode.SelectNodes("CNPJ")(0).Text 'Inscrição Estadual do emitente strIEEmite = "'" & xmlNode.SelectNodes("IE")(0).Text 'Regime tributario x = xmlNode.SelectNodes("CRT")(0).Text Select Case x Case 1 strRegTrib = "Simples Nacional" Case 2 strRegTrib = "Simples Nacional, excesso sublimite de receita bruta" Case 3 strRegTrib = "Regime Normal" End Select Next 'Chave da NFe For Each xmlNode In xmlDoc.getElementsByTagName("infProt") If xmlNode.SelectNodes("chNFe").Length > 0 Then strChaveNFe = "'" & xmlNode.SelectNodes("chNFe")(0).Text End If Next Set shtXml = ThisWorkbook.Sheets("LerXml") i = shtXml.Range("A1048576").End(xlUp).Row + 1 'Aqui vamos iniciar a ler os produtos da nota fiscal e carregar as linhas no excel conforme esses produtos Set xmlList = xmlDoc.getElementsByTagName("det") For Each xmlNode In xmlList strVlrFrt = "" dblVlrFrt = 0 strVlrSeg = "" dblVlrSeg = 0 strVlrDes = "" dblVlrDes = 0 strVlrOut = "" dblVlrOut = 0 strIcmsVlr = "" dblIcmsVlr = 0 strIcmsAlq = "" dblIcmsAlq = 0 strPisAlq = "" dblPisAlq = 0 strPisVlr = "" dblPisVlr = 0 strCofinAlq = "" dblCofinAlq = 0 strCofinVlr = "" dblCofinVlr = 0 strIcmsBcSt = "" dblIcmsBcSt = 0 strIcmsStVr = "" dblIcmsStVr = 0 strIpiVr = "" dblIpiVr = 0 strCodProd = GetNodeValue(xmlNode, "prod/cProd") strDescric = GetNodeValue(xmlNode, "prod/xProd") strNCM = GetNodeValue(xmlNode, "prod/NCM") intCFOP = GetNodeValue(xmlNode, "prod/CFOP") strEAN = "'" & GetNodeValue(xmlNode, "prod/cEAN") If strEAN = "'" Then strEAN = "" strEANTrib = "'" & GetNodeValue(xmlNode, "prod/cEANTrib") If strEANTrib = "'" Then strEANTrib = "" dblQtdCom = VBA.Replace(GetNodeValue(xmlNode, "prod/qCom"), ".", ",") dblQtdTri = VBA.Replace(GetNodeValue(xmlNode, "prod/qTrib"), ".", ",") dblVlrCom = VBA.Replace(GetNodeValue(xmlNode, "prod/vUnCom"), ".", ",") dblVlrTri = VBA.Replace(GetNodeValue(xmlNode, "prod/vUnTrib"), ".", ",") strVlrFrt = VBA.Replace(GetNodeValue(xmlNode, "prod/vFrete"), ".", ",") If strVlrFrt <> "" Then dblVlrFrt = strVlrFrt End If strVlrSeg = VBA.Replace(GetNodeValue(xmlNode, "prod/vSeg"), ".", ",") If strVlrSeg <> "" Then dblVlrSeg = strVlrSeg End If strVlrDes = VBA.Replace(GetNodeValue(xmlNode, "prod/vDesc"), ".", ",") If strVlrDes <> "" Then dblVlrDes = strVlrDes End If strVlrOut = VBA.Replace(GetNodeValue(xmlNode, "prod/vOutro"), ".", ",") If strVlrOut <> "" Then dblVlrOut = strVlrOut End If dblVlrTot = VBA.Replace(GetNodeValue(xmlNode, "prod/vProd"), ".", ",") strIcmsOr = GetICMS(xmlNode, 1) strIcmsCst = "'" & GetICMS(xmlNode, 2) If strIcmsCst = "'" Then strIcmsCst = "" strIcmsVlr = VBA.Replace(GetICMS(xmlNode, 3), ".", ",") If strIcmsVlr <> "" Then dblIcmsVlr = strIcmsVlr End If strIcmsAlq = VBA.Replace(GetICMS(xmlNode, 4), ".", ",") If strIcmsAlq <> "" Then dblIcmsAlq = strIcmsAlq dblIcmsAlq = dblIcmsAlq / 100 End If strPisCST = "'" & GetPIS(xmlNode, 1) If strPisCST = "'" Then strPisCST = "" strPisAlq = VBA.Replace(GetPIS(xmlNode, 2), ".", ",") If strPisAlq <> "" Then dblPisAlq = strPisAlq dblPisAlq = dblPisAlq / 100 End If strPisVlr = VBA.Replace(GetPIS(xmlNode, 3), ".", ",") If strPisVlr <> "" Then dblPisVlr = strPisVlr End If strCofinCST = "'" & GetCOFINS(xmlNode, 1) If strCofinCST = "'" Then strCofinCST = "" strCofinAlq = VBA.Replace(GetCOFINS(xmlNode, 2), ".", ",") If strCofinAlq <> "" Then dblCofinAlq = strCofinAlq dblCofinAlq = dblCofinAlq / 100 End If strCofinVlr = VBA.Replace(GetCOFINS(xmlNode, 3), ".", ",") If strCofinVlr <> "" Then dblCofinVlr = strCofinVlr End If ''''''''''' strIcmsBcSt = VBA.Replace(GetICMS(xmlNode, 5), ".", ",") If strIcmsBcSt <> "" Then dblIcmsBcSt = strIcmsBcSt End If strIcmsStVr = VBA.Replace(GetICMS(xmlNode, 6), ".", ",") If strIcmsStVr <> "" Then dblIcmsStVr = strIcmsStVr End If strIpiCST = "'" & GetIPI(xmlNode, 1) If strIpiCST = "'" Then strIpiCST = "" strIpiVr = VBA.Replace(GetIPI(xmlNode, 2), ".", ",") If strIpiVr <> "" Then dblIpiVr = strIpiVr End If 'Carregando informações na planilha shtXml.Cells(i, 1).Value = strEmitente shtXml.Cells(i, 2).Value = strCNPJEmi shtXml.Cells(i, 3).Value = strIEEmite shtXml.Cells(i, 4).Value = strRegTrib shtXml.Cells(i, 5).Value = strNoNFe shtXml.Cells(i, 6).Value = strSerie shtXml.Cells(i, 7).Value = strDEmi shtXml.Cells(i, 8).Value = strChaveNFe shtXml.Cells(i, 9).Value = strCodProd shtXml.Cells(i, 10).Value = strDescric shtXml.Cells(i, 11).Value = strNCM shtXml.Cells(i, 12).Value = intCFOP shtXml.Cells(i, 13).Value = strEAN shtXml.Cells(i, 14).Value = strEANTrib shtXml.Cells(i, 15).Value = dblQtdCom shtXml.Cells(i, 16).Value = dblQtdTri shtXml.Cells(i, 17).Value = dblVlrCom shtXml.Cells(i, 18).Value = dblVlrTri shtXml.Cells(i, 19).Value = dblVlrFrt shtXml.Cells(i, 20).Value = dblVlrSeg shtXml.Cells(i, 21).Value = dblVlrDes shtXml.Cells(i, 22).Value = dblVlrOut shtXml.Cells(i, 23).Value = dblVlrTot shtXml.Cells(i, 24).Value = strIcmsOr shtXml.Cells(i, 25).Value = strIcmsCst shtXml.Cells(i, 26).Value = dblIcmsAlq shtXml.Cells(i, 27).Value = dblIcmsVlr shtXml.Cells(i, 28).Value = dblIcmsBcSt shtXml.Cells(i, 29).Value = dblIcmsStVr shtXml.Cells(i, 30).Value = strPisCST shtXml.Cells(i, 31).Value = dblPisAlq shtXml.Cells(i, 32).Value = dblPisVlr shtXml.Cells(i, 33).Value = strCofinCST shtXml.Cells(i, 34).Value = dblCofinAlq shtXml.Cells(i, 35).Value = dblCofinVlr shtXml.Cells(i, 36).Value = strIpiCST shtXml.Cells(i, 37).Value = dblIpiVr i = i + 1 Next Set shtXml = Nothing Set xmlList = Nothing Set xmlNode = Nothing Set xmlDoc = Nothing End Sub Function GetNodeValue(node As IXMLDOMNode, xp As String) Dim n As IXMLDOMNode, nv Set n = node.SelectSingleNode(xp) If Not n Is Nothing Then nv = n.nodeTypedValue GetNodeValue = nv Set n = Nothing End Function Function GetICMS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer) 'Caso a opção intCampo seja: '1 = origem '2 = CST/COSN '3 = Valor do ICMS '4 = Aliquota ICMS '5 = Base de calculo ICMS ST '6 = Valor ICMS ST Dim strCampo As String Dim strCampoSn As String Select Case intCampo Case 1 strCampo = "orig" strCampoSn = "orig" Case 2 strCampo = "CST" strCampoSn = "CSOSN" Case 3 strCampo = "vICMS" strCampoSn = "vICMS" Case 4 strCampo = "pICMS" strCampoSn = "pICMS" Case 5 strCampo = "vBCST" strCampoSn = "vBCST" Case 6 strCampo = "vICMSST" strCampoSn = "vICMSST" End Select Dim n As IXMLDOMNode, nv Set n = node.SelectSingleNode("imposto/ICMS/ICMS00/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS10/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS20/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS30/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS40/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS41/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS50/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS51/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS60/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS70/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMS90/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN101/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN102/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN103/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN201/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN202/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN203/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN300/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN400/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN500/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN900/" & strCampoSn) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Fim: GetICMS = nv Set n = Nothing End Function Function GetPIS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer) 'Caso a opção intCampo seja: '1 = CST '2 = Aliquota PIS '3 = Valor PIS Dim strCampo As String Select Case intCampo Case 1 strCampo = "CST" Case 2 strCampo = "pPIS" Case 3 strCampo = "vPIS" End Select Dim n As IXMLDOMNode, nv Set n = node.SelectSingleNode("imposto/PIS/PISAliq/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/PIS/PISQtde/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/PIS/PISNT/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/PIS/PISOutr/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/PIS/PISST/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Fim: GetPIS = nv Set n = Nothing End Function Function GetCOFINS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer) 'Caso a opção intCampo seja: '1 = CST '2 = Aliquota COFINS '3 = Valor COFINS Dim strCampo As String Select Case intCampo Case 1 strCampo = "CST" Case 2 strCampo = "pCOFINS" Case 3 strCampo = "vCOFINS" End Select Dim n As IXMLDOMNode, nv Set n = node.SelectSingleNode("imposto/COFINS/COFINSAliq/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/COFINS/COFINSQtde/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/COFINS/COFINSNT/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/COFINS/COFINSOutr/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/COFINS/COFINSST/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Fim: GetCOFINS = nv Set n = Nothing End Function Function GetIPI(ByVal node As IXMLDOMNode, ByVal intCampo As Integer) 'Caso a opção intCampo seja: '1 = CST '2 = Valor IPI Dim strCampo As String Select Case intCampo Case 1 strCampo = "CST" Case 2 strCampo = "vIPI" End Select Dim n As IXMLDOMNode, nv Set n = node.SelectSingleNode("imposto/IPI/IPITrib/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Set n = node.SelectSingleNode("imposto/IPI/IPINT/" & strCampo) If Not n Is Nothing Then nv = n.nodeTypedValue GoTo Fim End If Fim: GetIPI = nv Set n = Nothing End Function