Boa tarde
Desde já agradeço qualquer ajuda.
Criei um sistema de vendas em Access 2007. Estou trabalhando agora na importação do XML das notas fiscais de compra de produtos para a tabela/formulário de compras.
Para isso, pesquisei sobre importação de xml e como resultado, na lista de repositório fiz o download de um exemplo do Fabio Paes. Agradeço a ele o exemplo disponibilizado:
https://www.maximoaccess.com/t29286-importar-todas-as-nfe-nota-fiscal-eletronica-xml-de-uma-pasta-versao-xml-1-10-2-00-e-3-10?highlight=nota+fiscal
Fiz algumas alterações no código em função de nomes de campos e preenchimentos a partir do XML. A parte do código que verifica e cadastra fornecedor, e dados principais do formulário de compras está OK. Realizei testes disso, usando apóstrofo nas linhas que eu ainda não tinha ajustado, ficando para um segundo momento somente a parte de produtos a serem cadastrados.
Após concluir essa parte, tentei fazer a importação do XML, porém recebo o erro:
Erro em tempo de execução '3420': O objeto não é válido ou não está definido.
Ao clicar em depurar, o VBA mostra essa linha do código:
Set rsComprasDetalhes = DB.OpenRecordset("tbl_CadComprasDetalhes")
Pela mensagem de erro, fiz algumas pesquisas mas não identifiquei o erro ainda. Pelo erro "não está definido", verifiquei essa linha do código:
Dim rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes As DAO.Recordset
O nome está correto. Verifiquei também o nome da tabela, e pelo que vejo está correto. Segue o código.
O banco está em anexo, junto com o XML de uma nota.
Obrigado.
Enio Eltz Filho.
Desde já agradeço qualquer ajuda.
Criei um sistema de vendas em Access 2007. Estou trabalhando agora na importação do XML das notas fiscais de compra de produtos para a tabela/formulário de compras.
Para isso, pesquisei sobre importação de xml e como resultado, na lista de repositório fiz o download de um exemplo do Fabio Paes. Agradeço a ele o exemplo disponibilizado:
https://www.maximoaccess.com/t29286-importar-todas-as-nfe-nota-fiscal-eletronica-xml-de-uma-pasta-versao-xml-1-10-2-00-e-3-10?highlight=nota+fiscal
Fiz algumas alterações no código em função de nomes de campos e preenchimentos a partir do XML. A parte do código que verifica e cadastra fornecedor, e dados principais do formulário de compras está OK. Realizei testes disso, usando apóstrofo nas linhas que eu ainda não tinha ajustado, ficando para um segundo momento somente a parte de produtos a serem cadastrados.
Após concluir essa parte, tentei fazer a importação do XML, porém recebo o erro:
Erro em tempo de execução '3420': O objeto não é válido ou não está definido.
Ao clicar em depurar, o VBA mostra essa linha do código:
Set rsComprasDetalhes = DB.OpenRecordset("tbl_CadComprasDetalhes")
Pela mensagem de erro, fiz algumas pesquisas mas não identifiquei o erro ainda. Pelo erro "não está definido", verifiquei essa linha do código:
Dim rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes As DAO.Recordset
O nome está correto. Verifiquei também o nome da tabela, e pelo que vejo está correto. Segue o código.
- Código:
Option Compare Database
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 rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes As DAO.Recordset
Dim cProd As String
Dim i, x, regAtual As Integer
DoCmd.OpenForm "fml_AguardeXML"
Forms!fml_AguardeXML!txt_erros = "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.
If doc.Validate.ErrorCode = -1072897500 And (doc.getElementsByTagName("chNFe").Length) Then 'If_001 Verifica se o Arquivo foi aberto corretamente e se possui chave. Se possuir importa, se nao Pula pra o Proximo!
Set xDet = doc.getElementsByTagName("det")
'********************Insere os Dados do Fornecedor, se nao for Cadastrado.********************
Set rsFornecedores = DB.OpenRecordset("tbl_CadFornecedores")
x = Nz(DLookup("COD_tbl_CadFornecedores", "tbl_CadFornecedores", "CNPJ = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'x buscará o fornecedor na tabela "tbl_CadFornecedores"
xCidade = Nz(DLookup("COD_tbl_CadCidades", "tbl_CadCidades", "CIDADE = '" & doc.getElementsByTagName("xMun")(0).Text & "'"), 0) 'x buscará a cidade na tabela "tbl_CadCidades"
If x <= 0 Then 'If_002 Se x for <=0 significa que não está cadastrado, então irá cadastrar o fornecedor
rsFornecedores.AddNew
rsFornecedores!NOME_FORNECEDOR = doc.getElementsByTagName("xFant")(0).Text
rsFornecedores!RAZAO_SOCIAL = doc.getElementsByTagName("xNome")(0).Text
rsFornecedores!CNPJ = doc.getElementsByTagName("CNPJ")(0).Text
rsFornecedores!INSCR_EST = doc.getElementsByTagName("IE")(0).Text
rsFornecedores!END_FORN = doc.getElementsByTagName("xLgr")(0).Text
rsFornecedores!CIDADE_FORN = xCidade
rsFornecedores!NUM_END_FORN = doc.getElementsByTagName("nro")(0).Text
rsFornecedores!ESTADO_FORN = doc.getElementsByTagName("UF")(0).Text
rsFornecedores!CEP_FORN = doc.getElementsByTagName("CEP")(0).Text
rsFornecedores!TELEFONE = doc.getElementsByTagName("fone")(0).Text
rsFornecedores.Update
x = Nz(DLookup("COD_tbl_CadFornecedores", "tbl_CadFornecedores", "CNPJ = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'Apos cadastrar o fornecedor, x buscara o ID desse fornecedor para ser utilizado na importação do xml em questao
rsFornecedores.Close
Set rsFornecedores = Nothing
End If 'If_002
'********************Dados Principais da Nota de Compra (tbl_CadCompras)********************
xTipo = "2"
Set rsCompras = DB.OpenRecordset("tbl_CadCompras")
rsCompras.AddNew
rsCompras!CHAVE_TBL = "CO"
rsCompras!NUM_PEDIDO = doc.getElementsByTagName("nNF")(0).Text
'**********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 'If_003
rsCompras!DATA_PEDIDO = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
Else
rsCompras!DATA_PEDIDO = Format(doc.getElementsByTagName("dEmi")(0).Text, "dd/mm/yyyy")
End If 'If_003
rsCompras!FORNECEDOR = x
rsCompras!DATA_1A_PARCELA = doc.getElementsByTagName("dVenc")(0).Text
rsCompras!TIPO_PGTO = xTipo
rsCompras.QTDE_PARCELA = "1"
rsCompras.VALOR_BOLETO = "1,30"
rsCompras.Update
regAtual = Nz(DLookup("COD_tbl_CadCompras", "tbl_CadCompras", "NUM_PEDIDO = '" & doc.getElementsByTagName("nNF")(0).Text & "'"), 0)
rsCompras.Close
Set rsCompras = Nothing
'********************Dados dos Produtos********************
i = 0
cProd = ""
'**********Aqui é o Loop que percorrerá pela Tag "det" que são os produtos. Buscar produto a produto, e o inserirá na nota que esta sendo importada**********
For Each det In xDet
cProd = doc.getElementsByTagName("det")(i).XML ' cProd desmembrará o xml pegando produto a produto...
x = Nz(DLookup("COD_tbl_CadProdutos", "tbl_CadProdutos", "COD_PRODUTO = '" & separaEntreDuasStringsXML(cProd, "<cProd>", "</cProd>") & "'"), 0)
'**********Cadastra o Produto, pois ainda nao foi cadastrado**********
If x <= 0 Then 'If_004
Set rsProdutos = DB.OpenRecordset("tbl_CadProdutos")
xFornecedor = Nz(DLookup("COD_tbl_CadFornecedores", "tbl_CadFornecedores", "CNPJ = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'X buscará o fornecedor na tabela "tbl_CadFornecedores"
xValorCompra = separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>")
xValorVenda = (xValorCompra * 100) / 70
rsProdutos.AddNew
rsProdutos!COD_PRODUTO = separaEntreDuasStringsXML(cProd, "<cProd>", "</cProd>")
rsProdutos!DESCRICAO_PRODUTO = separaEntreDuasStringsXML(cProd, "<xProd>", "</xProd>")
rsProdutos!DESCRICAO_NFE = separaEntreDuasStringsXML(cProd, "<xProd>", "</xProd>")
rsProdutos!NOME_FORNECEDOR = xFornecedor
rsProdutos!VALOR_COMPRA = separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>")
rsProdutos!VALOR_VENDA = xValorVenda
rsProdutos.Update
Else
'**********Ajusta os valores de compra e venda do produto se ele já estiver cadastrado.**********
xValorCompra = separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>")
xValorVenda = (xValorCompra * 100) / 70
Dim rsValor As Recordset
Set DB = CurrentDb
Set rsValor = DB.OpenRecordset("select VALOR_COMPRA, COD_tbl_CadProdutos from tbl_CadProdutos where COD_tbl_CadProdutos = " & x & "")
rsValor.Edit
rsValor("VALOR_COMPRA") = xValorCompra
rsValor.Update
rsValor.Close
DB.Close
Set DB = CurrentDb
Set rsValor = DB.OpenRecordset("select VALOR_VENDA, COD_tbl_CadProdutos from tbl_CadProdutos where COD_tbl_CadProdutos = " & x & "")
rsValor.Edit
rsValor("VALOR_VENDA") = xValorVenda
rsValor.Update
rsValor.Close
DB.Close
End If 'If_004
x = Nz(DLookup("COD_tbl_CadProdutos", "tbl_CadProdutos", "COD_PRODUTO = '" & separaEntreDuasStringsXML(cProd, "<cProd>", "</cProd>") & "'"), 0)
'**********Insere o produto cadastrado na Nota de compra**********
Set rsComprasDetalhes = DB.OpenRecordset("tbl_CadComprasDetalhes")
rsComprasDetalhes.AddNew
rsComprasDetalhes!COD_ME_tbl_CadCompras = regAtual
rsComprasDetalhes!COD_PRODUTO = x
rsComprasDetalhes!DESC_PRODUTO = Replace(separaEntreDuasStringsXML(cProd, "<xProd>", "</xProd>"), ".", ",")
rsComprasDetalhes!QUANTIDADE = Replace(separaEntreDuasStringsXML(cProd, "<qCom>", "</qCom>"), ".", ",")
rsComprasDetalhes!PRECO_COMPRA = Replace(separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>"), ".", ",")
rsComprasDetalhes.Update
rsComprasDetalhes.Close
rsProdutos.Close
Set rsComprasDetalhes = Nothing
Set rsProdutos = Nothing
'**********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!fml_AguardeXML!txt_erros = Forms!fml_AguardeXML!txt_erros & vbNewLine & NomeArq
Forms!fml_AguardeXML.Requery
End If 'If_001
'********************Loop dos arquivos, pega o proximo arquivo********************
NomeArq = Dir()
Loop
Forms!fml_CadCompras.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
O banco está em anexo, junto com o XML de uma nota.
Obrigado.
Enio Eltz Filho.
- Anexos
arquivoz.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (1.1 Mb) Baixado 76 vez(es)