Nesse exemplo o sistema realiza o lançamento automático das Notas Fiscais Eletrônica Brasileira. Bastando o usuário informar onde está a Pasta com os arquivos Xml. É realizado o desmembramento dos dados em 4 tabelas (tbCadProd, tbFornecedores, tbCompras e tbComprasDet)
O método utilizado é o de Leitura do arquivo XML combinado com a função separaEntreDuasStringsXML do Ahteixeira.
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Tela10](https://i.servimg.com/u/f58/19/61/61/28/tela10.jpg)
1. Lança todas as NFe de uma pasta
´ 1.1 Verifica se o Fornecedor está cadastrado:
´ 1.1.1 Se não tiver, realiza o Cadastramento
´ 1.1.2 Se Tiver, apenas busca o Código para lançar a Compra
´ 1.2 Verifica se o Produto está cadastrado:
´ 1.2.1 Se não tiver, realiza o Cadastramento e lança o Estoque
´ 1.2.2 Se Tiver, busca o Código para lançar na compra e atualiza o Estoque
Com pequenos comando do usuário final, é possível lançar a compra, cadastrar o Fornecedor e Cadastrar os Produtos.
Testes realizados:
Importação de 6.038 arquivos .xml.
Importação local, realizada com uma máquina Pentium 4:
Importado 6.007 NFe, Cadastrado 4.031 Produtos e Ignorado 31 Xml com erro
Tempo gasto: 4min31seg
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Lanyam10](https://i.servimg.com/u/f58/19/61/61/28/lanyam10.jpg)
Em Anexo na pasta XML tem 5 arquivos, sendo que 1 contém erro.
Ao realizar a importação deverá conter:
38 Produtos, 4 Notas de compra e 3 Fornecedores.
Extrutura de um XML
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Extrut10](https://i.servimg.com/u/f58/19/61/61/28/extrut10.png)
Obs: Se for detectado Erros ou houver sugestão de melhorias por favor voltar a este Tópico e reportar, assim todos termos o melhor!
Caso acuse erro 13, a variável não foi definida deve verificar se a TAG XML buscada foi encontrada, ou se o arquivo e um xml válido.
Se atentar para as referências, caso moca o projeto para seu aplicativo.
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Refere10](https://i.servimg.com/u/f58/19/61/61/28/refere10.jpg)
Modulo de Importação:
Função separaEntreDuasStringsXML:
Tópicos Relacionados:
https://www.maximoaccess.com/t29830-resolvidoerro-ao-importar-xml
https://www.maximoaccess.com/t29919-resolvidoimportar-dados-do-destinatario-da-nf-e-xml#207920
O método utilizado é o de Leitura do arquivo XML combinado com a função separaEntreDuasStringsXML do Ahteixeira.
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Tela10](https://i.servimg.com/u/f58/19/61/61/28/tela10.jpg)
O que o sistema faz:
1. Lança todas as NFe de uma pasta
´ 1.1 Verifica se o Fornecedor está cadastrado:
´ 1.1.1 Se não tiver, realiza o Cadastramento
´ 1.1.2 Se Tiver, apenas busca o Código para lançar a Compra
´ 1.2 Verifica se o Produto está cadastrado:
´ 1.2.1 Se não tiver, realiza o Cadastramento e lança o Estoque
´ 1.2.2 Se Tiver, busca o Código para lançar na compra e atualiza o Estoque
Com pequenos comando do usuário final, é possível lançar a compra, cadastrar o Fornecedor e Cadastrar os Produtos.
Testes realizados:
Importação de 6.038 arquivos .xml.
Importação local, realizada com uma máquina Pentium 4:
Importado 6.007 NFe, Cadastrado 4.031 Produtos e Ignorado 31 Xml com erro
Tempo gasto: 4min31seg
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Lanyam10](https://i.servimg.com/u/f58/19/61/61/28/lanyam10.jpg)
Em Anexo na pasta XML tem 5 arquivos, sendo que 1 contém erro.
Ao realizar a importação deverá conter:
38 Produtos, 4 Notas de compra e 3 Fornecedores.
Extrutura de um XML
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Extrut10](https://i.servimg.com/u/f58/19/61/61/28/extrut10.png)
Obs: Se for detectado Erros ou houver sugestão de melhorias por favor voltar a este Tópico e reportar, assim todos termos o melhor!
Caso acuse erro 13, a variável não foi definida deve verificar se a TAG XML buscada foi encontrada, ou se o arquivo e um xml válido.
Se atentar para as referências, caso moca o projeto para seu aplicativo.
![Importar todas as NFe (Nota Fiscal Eletrônica (Xml)) de uma pasta (versão Xml: 1.10, 2.00 e 3.10) Refere10](https://i.servimg.com/u/f58/19/61/61/28/refere10.jpg)
Modulo de Importação:
- Código:
Public Function ImportaXML(LocalXml As String)
'---------------------------------------------------------------'
' Criado por FabioPaes '
' Em 12/02/2017 para MAXIMOACCESS '
' Em caso de correçoes reportar a origem para atualizar o codigo'
'---------------------------------------------------------------'
Dim doc As DOMDocument
Dim xDet As IXMLDOMNodeList
Dim NomeArq As String
Dim DB As Database
Dim rsFor, rsProd, rsCompra, rsCompDet As DAO.Recordset
Dim xProd As String
Dim i, x, regAtual As Integer
DoCmd.OpenForm "frmAguarde"
Forms!frmaguarde!txt2 = "Xml Com Erros:"
Diret = LocalXml
NomeArq = Dir(Diret & "*.XML", vbArchive)
Set DB = CurrentDb()
Set doc = New DOMDocument
'Buscará todos os arquivos com extenção .xml da pasta selecionada
Do While NomeArq <> ""
doc.Load (LocalXml & NomeArq) 'Pega a Pasta e o Nome do primeiro arquivo....
'Verifica se o Arquivo foi aberto corretamente e se possui chave. Se possuir importa, se nao Pula pra o Proximo!
If doc.validate.errorCode = -1072897500 And (doc.getElementsByTagName("chNFe").length) Then
Set xDet = doc.getElementsByTagName("det")
'------------------------------------------------------------------------'
'Insere os Dados do Fornecedor, se nao for Cadastrado.
Set rsFor = DB.OpenRecordset("tbFornecedores")
x = Nz(DLookup("IdFor", "tbFornecedores", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'X buscará o fornecedor na tabela "tbFornecedores"
If x <= 0 Then 'Se x for <=0 significa que nao ta cadastrado, entao irá cadastrar o fornecedor
rsFor.AddNew
rsFor!NomeForn = doc.getElementsByTagName("xNome")(0).Text
rsFor!CNPJ = doc.getElementsByTagName("CNPJ")(0).Text
rsFor.Update
'Apos cadastrar o fornecedor, x buscara o ID desse fornecedor para ser utilizado na importação do xml em questao
x = Nz(DLookup("IdFor", "tbFornecedores", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0)
rsFor.Close
Set rsFor = Nothing
End If
'------------------------------------------------------------------------'
'Dados Principais da Nota de Compra (tbCompras)
Set rsCompra = DB.OpenRecordset("tbCompras")
rsCompra.AddNew
rsCompra!IdFornecedor = x
'Necessario essa verificação pois na versao XML 1.10 era somente Data (dEmi) ja na 3.0 mudou para DataHora (dhEmi)
If (doc.getElementsByTagName("dhEmi").length) Then
rsCompra!DataCompra = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
Else
rsCompra!DataCompra = Format(doc.getElementsByTagName("dEmi")(0).Text, "dd/mm/yyyy")
End If
'Passa os totais da NFe para a variavel xProd
xProd = doc.getElementsByTagName("total")(0).XML
'Valor Bruto sem desconto
rsCompra!ValorNFB = Replace(separaEntreDuasStringsXML(xProd, "<vProd>", "</vProd>"), ".", ",")
'Valor Liquido "Valor Bruto-descontos"
rsCompra!ValorNFL = Replace(separaEntreDuasStringsXML(xProd, "<vNF>", "</vNF>"), ".", ",")
rsCompra!NumNF = doc.getElementsByTagName("nNF")(0).Text
rsCompra!ChaveNF = doc.getElementsByTagName("chNFe")(0).Text
rsCompra.Update
regAtual = Nz(DLookup("ID", "tbCompras", "ChaveNF = '" & doc.getElementsByTagName("chNFe")(0).Text & "'"), 0)
rsCompra.Close
Set rsCompra = Nothing
'------------------------------------------------------------------------'
' Dados dos Produtos
i = 0
xProd = ""
'Aqui é o Loop que percorrerá pela Tag "det" que são os produtos..
'Buscara produto a produto, e o inserirá na nota que esta sendo importada
For Each det In xDet
xProd = doc.getElementsByTagName("det")(i).XML ' xProd desmembrará o xml pegando produto a produto...
x = Nz(DLookup("IdProd", "tbCadProd", "DescProd = '" & separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>") & "'"), 0)
If x <= 0 Then
'Cadastra o Produto, pois ainda nao foi cadastrado
Set rsProd = DB.OpenRecordset("tbCadProd")
rsProd.AddNew
rsProd!DescProd = separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>")
rsProd!Unid = separaEntreDuasStringsXML(xProd, "<uCom>", "</uCom>")
rsProd!Estoque = Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
rsProd.Update
x = Nz(DLookup("IdProd", "tbCadProd", "DescProd = '" & separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>") & "'"), 0)
'Insere o produto cadastrado na Nota de compra
Set rsCompDet = DB.OpenRecordset("tbComprasDet")
rsCompDet.AddNew
rsCompDet!IDCompra = regAtual
rsCompDet!IDProd = x
rsCompDet!Qnt = Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
rsCompDet!ValorUnit = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",")
rsCompDet!ValorTot = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
rsCompDet!ICMS = Replace(separaEntreDuasStringsXML(xProd, "<pICMS>", "</pICMS>"), ".", ",")
rsCompDet.Update
rsCompDet.Close
rsProd.Close
Set rsCompDet = Nothing
Set rsProd = Nothing
Else
Set rsProd = DB.OpenRecordset("SELECT * FROM tbCadProd WHERE IdProd = " & x & "")
rsProd.Edit 'Atualiza o estoque do produto
rsProd!Estoque = rsProd!Estoque + Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
rsProd.Update
'Insere o produto que ja estava cadastrado na Nota de compra
Set rsCompDet = DB.OpenRecordset("tbComprasDet")
rsCompDet.AddNew
rsCompDet!IDCompra = regAtual
rsCompDet!IDProd = x
rsCompDet!Qnt = Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",") 'O replace e utilizado para substituir o . por ,
rsCompDet!ValorUnit = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",")
rsCompDet!ValorTot = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
rsCompDet!ICMS = Nz(Replace(separaEntreDuasStringsXML(xProd, "<pICMS>", "</pICMS>"), ".", ","), 0)
rsCompDet.Update
'Limpa os dados do recordset e fecha a conecção
rsCompDet.Close
rsProd.Close
Set rsCompDet = Nothing
Set rsProd = Nothing
End If
'Add 1 unidade ao contador para pegar o proximo produto
i = i + 1
Next
Else
'Se abrir xml com erro, será add no formulario "aguarde" o nome dele
Forms!frmaguarde!txt2 = Forms!frmaguarde!txt2 & vbNewLine & NomeArq
Forms!frmaguarde.Requery
End If
'Loop dos arquivos, pega o proximo arquivo
NomeArq = Dir()
Loop
Forms!frmCompras.Requery
MsgBox "Todos os XMLs da pasta selecionada Foram Importados com Sucesso! " & vbNewLine & "Verifique as Notas lançadas!!!", vbInformation, "Sucesso!!!"
DB.Close
Set DB = Nothing
End Function
Função separaEntreDuasStringsXML:
- Código:
Function separaEntreDuasStringsXML(strTotal As String, strInicio As String, strFim As String)
' 2014 Alvaro Teixeira '
' Adaptado por Fabio Paes '
' Em 12/02/2017 para MAXIMOACCESS '
Dim strP As String
On Error Resume Next
Dim i As Long, j As Long
i = InStr(strTotal, strInicio)
'Aqui ele separa o Texto para determinar o Fim da Extração.
strP = Mid(strTotal, i + (Len(strInicio)), Len(strTotal))
j = InStr(strP, strFim)
separaEntreDuasStringsXML = Mid(strTotal, i + Len(strInicio), j - 1)
If Nz(Len(separaEntreDuasStringsXML), 0) = 0 Then
separaEntreDuasStringsXML = 0
End If
End Function
Tópicos Relacionados:
https://www.maximoaccess.com/t29830-resolvidoerro-ao-importar-xml
https://www.maximoaccess.com/t29919-resolvidoimportar-dados-do-destinatario-da-nf-e-xml#207920
- Anexos
Importa NFe Xml Lote.zip
- 20/02/2017 10:13
- Você não tem permissão para fazer download dos arquivos anexados.
- (73 Kb) Baixado 1154 vez(es)
Última edição por FabioPaes em 15/4/2017, 23:44, editado 3 vez(es) (Motivo da edição : Correção no Código)