MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    [Resolvido]Erro ao importar XML

    avatar
    enio.eltz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 63
    Registrado : 19/07/2016

    [Resolvido]Erro ao importar XML Empty [Resolvido]Erro ao importar XML

    Mensagem  enio.eltz 5/4/2017, 20:49

    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.


    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
    [Resolvido]Erro ao importar XML Attachmentarquivoz.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (1.1 Mb) Baixado 77 vez(es)
    FabioPaes
    FabioPaes
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3914
    Registrado : 14/08/2013

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  FabioPaes 6/4/2017, 13:33

    Ola, amigo uma verificada Rápida percebi que você deu uma perdida no codigo...

    O Motivo do erro é que a Variável BD (que define a qual BD iremos consultar) está fechada (Não definida) na hora que tenta abrir o recordset do detalhe da compra... Isso ocorre porque nas linhas anteriores ao do erro vc fechou por diversas vezes a Variavel BD (DB.Cloes).

    Não ha a necessidade de fechar essa variável, pois sempre usaremos o mesmo BD... So havendo a necessidade de fechar ela no final do Codigo.


    Corrija, substituindo por esse:
    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 rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes As DAO.Recordset

    Dim rsValor As 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" 'Mudei aqui... Estava  rsCompras.QTDE_PARCELA onde na verdade deve informa com ! e nao com .
        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


        '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


    Veja que onde encontrei erros eu apenas comentei a linha, para que vc veja onde estava a errar.

    Verifique mais a fundo se não ha erros, pois olhei muito Rápido suas mudanças!


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!
    avatar
    enio.eltz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 63
    Registrado : 19/07/2016

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  enio.eltz 6/4/2017, 13:55

    Bom dia Fabio

    Muito obrigado!!!!!
    Realmente era a situação de fechar a variável BD.
    Para que você entenda, esse sistema eu criei para minha esposa gerenciar as vendas dela. Aprendi bastante com isso, mas esse é um código mais complexo, e aprendi bastante com ele.
    No código que eu mandei, há a parte que ajusta valores de compra e venda, e isso eu tenho em uso em um outro formulário:

       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

    Como eu copiei, ele "abriu" a variável BD que já estava aberta e depois fechou, criando o problema.
    Mas é isso, estou aprendendo. Vou documentar isso para que não tenha problemas novamente.

    Grande abraço!

    Enio Eltz Filho.
    FabioPaes
    FabioPaes
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3914
    Registrado : 14/08/2013

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  FabioPaes 6/4/2017, 14:49

    Bacana! Faça bom proveito da Função!

    Grato pelo retorno amigo, até a próxima se Deus Quiser!


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!
    avatar
    enio.eltz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 63
    Registrado : 19/07/2016

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  enio.eltz 6/4/2017, 20:15

    Boa tarde

    Estou enviando o código atualizado, pois tive que realizar uma alteração. O que estava acontecendo é que, ao importar, eu criei no código regras para atualizar o valor de compra e calcular o valor de venda. Mas o XML tem o valor com ponto antes das casas decimais. Por exemplo 2.5000000000000 para R$ 2,50. Ao importar, ele estava colocando os valor em bilhões de reais.

    O problema era que no código, em linhas que buscam esse valor no XML estavam assim:

    rsComprasDetalhes!PRECO_COMPRA = separaEntreDuasStringsXML(cProd, "", "")

    Mas precisa ser assim:

    rsComprasDetalhes!PRECO_COMPRA = Replace(separaEntreDuasStringsXML(cProd, "", ""), ".", ",")

    Com o Replace antes, o código vai substituir o ponto pela vírgula. Alterei todas as linhas que buscam valores com ponto para esse formato. Não é difícil de entender o que ocorreu analisando o código, mas como tive grande ajuda nesse caso, compartilho a informaçã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 rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes As DAO.Recordset

    Dim rsValor As 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 = Replace(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 = xValorCompra
        rsProdutos!VALOR_VENDA = xValorVenda
        rsProdutos!CFOP = separaEntreDuasStringsXML(cProd, "<CFOP>", "</CFOP>")
        rsProdutos!NCM = separaEntreDuasStringsXML(cProd, "<NCM>", "</NCM>")
    rsProdutos.Update
    Else
        '**********Ajusta os valores de compra e venda do produto se ele já estiver cadastrado.**********
    xValorCompra = Replace(separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>"), ".", ",")
    xValorVenda = (xValorCompra * 100) / 70

        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
        
        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
        
    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 = separaEntreDuasStringsXML(cProd, "<xProd>", "</xProd>")
        rsComprasDetalhes!QUANTIDADE = Replace(separaEntreDuasStringsXML(cProd, "<qCom>", "</qCom>"), ".", ",")
        rsComprasDetalhes!PRECO_COMPRA = Replace(separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>"), ".", ",")
        rsComprasDetalhes!CFOP_COMP = separaEntreDuasStringsXML(cProd, "<CFOP>", "</CFOP>")
        rsComprasDetalhes!NCM_COMP = separaEntreDuasStringsXML(cProd, "<NCM>", "</NCM>")
    rsComprasDetalhes.Update
    rsComprasDetalhes.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

    É claro que, para quem trabalha com isso todos os dias, isso é básico, mas não custa compartilhar.

    Grande abraço!!!

    Enio Eltz Filho.
    FabioPaes
    FabioPaes
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3914
    Registrado : 14/08/2013

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  FabioPaes 6/4/2017, 20:30

    Justamente, há a necessidade de Substituir o . por ,.


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!
    avatar
    enio.eltz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 63
    Registrado : 19/07/2016

    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  enio.eltz 10/4/2017, 11:48

    Bom dia

    Segue o código atualizado. Alguém pode ter essa necessidade também.
    Incluí o cadastro de tipo de pagamentos. E o registro das faturas a serem pagas na nota de compra.

    Enio Eltz Filho.

    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 xDup As IXMLDOMNodeList
    Dim xICMSTot As IXMLDOMNodeList
    Dim NomeArq As String
    Dim DB As Database
    Dim rsFornecedores, rsProdutos, rsCompras, rsComprasDetalhes, rsComprasPgto, rsValor, rsParcela As DAO.Recordset

    Dim cProd As String
    Dim cDup As String
    Dim cICMSTot As String
    Dim i, x, d, t, v, 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")
    Set xDup = doc.getElementsByTagName("dup")
    Set xICMSTot = doc.getElementsByTagName("ICMSTot")

    '********************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

    '********************Insere o dados do tipo de pagamento, se não for cadastrado********************

    Set rsTipoPgto = DB.OpenRecordset("tbl_CadTipoPagamentos")
    t = Nz(DLookup("COD_tbl_CadTipoPagamentos", "tbl_CadTipoPagamentos", "TIPO_NFE = '" & doc.getElementsByTagName("infCpl")(0).Text & "'"), 0) 't buscará a forma de pgto na tabela "tbl_CadTipoPagamentos"

    If t <= 0 Then 'If_003
        rsTipoPgto.AddNew
            rsTipoPgto!TIPO_PAGAMENTO = doc.getElementsByTagName("infCpl")(0).Text
            rsTipoPgto!TIPO_NFE = doc.getElementsByTagName("infCpl")(0).Text
        rsTipoPgto.Update
        
    t = Nz(DLookup("COD_tbl_CadTipoPagamentos", "tbl_CadTipoPagamentos", "TIPO_NFE = '" & doc.getElementsByTagName("infCpl")(0).Text & "'"), 0) 'Apos cadastrar o tipo pgto, t buscara o ID desse tipo para ser utilizado na importação do xml em questao
    rsTipoPgto.Close
    Set rsTipoPgto = Nothing
    End If 'If 003

    '********************Dados Principais da Nota de Compra (tbl_CadCompras)********************

    v = 0
    cICMSTot = ""
    cICMSTot = doc.getElementsByTagName("ICMSTot")(v).XML
    xTipo = Nz(DLookup("COD_tbl_CadTipoPagamentos", "tbl_CadTipoPagamentos", "TIPO_NFE = '" & doc.getElementsByTagName("infCpl")(0).Text & "'"), 0) 'x buscará a forma de pgto na tabela "tbl_CadTipoPagamentos"

    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_004
        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_004
        rsCompras!FORNECEDOR = x
        rsCompras!DATA_1A_PARCELA = doc.getElementsByTagName("dVenc")(0).Text
        rsCompras!TIPO_PGTO = xTipo
        rsCompras!VALOR_BOLETO = Replace(separaEntreDuasStringsXML(cICMSTot, "<vOutro>", "</vOutro>"), ".", ",")
        rsCompras!VALOR_TOT_NFE = Replace(doc.getElementsByTagName("vOrig")(0).Text, ".", ",")
        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
    d = 0
    cProd = ""
    cDup = ""
    '**********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_005
    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 = Replace(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 = xValorCompra
        rsProdutos!VALOR_VENDA = xValorVenda
        rsProdutos!CFOP = separaEntreDuasStringsXML(cProd, "<CFOP>", "</CFOP>")
        rsProdutos!NCM = separaEntreDuasStringsXML(cProd, "<NCM>", "</NCM>")
    rsProdutos.Update
    Else
        '**********Ajusta os valores de compra e venda do produto se ele já estiver cadastrado.**********
    xValorCompra = Replace(separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>"), ".", ",")
    xValorVenda = (xValorCompra * 100) / 70

        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
        
        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
        
    End If 'If_005

    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 = separaEntreDuasStringsXML(cProd, "<xProd>", "</xProd>")
        rsComprasDetalhes!QUANTIDADE = Replace(separaEntreDuasStringsXML(cProd, "<qCom>", "</qCom>"), ".", ",")
        rsComprasDetalhes!PRECO_COMPRA = Replace(separaEntreDuasStringsXML(cProd, "<vUnCom>", "</vUnCom>"), ".", ",")
        rsComprasDetalhes!CFOP_COMP = separaEntreDuasStringsXML(cProd, "<CFOP>", "</CFOP>")
        rsComprasDetalhes!NCM_COMP = separaEntreDuasStringsXML(cProd, "<NCM>", "</NCM>")
    rsComprasDetalhes.Update
    rsComprasDetalhes.Close

    Set rsComprasDetalhes = Nothing
    Set rsProdutos = Nothing
        '**********Add 1 unidade ao contador para pegar o proximo produto**********
    i = i + 1
    Next

    nParc = "1"
    xTipo = Nz(DLookup("COD_tbl_CadTipoPagamentos", "tbl_CadTipoPagamentos", "TIPO_NFE = '" & doc.getElementsByTagName("infCpl")(0).Text & "'"), 0) 'x buscará a forma de pgto na tabela "tbl_CadTipoPagamentos"

    For Each nDup In xDup
    cDup = doc.getElementsByTagName("dup")(d).XML ' cDup desmembrará o xml pegando boleto a boleto...

    Set rsComprasPgto = DB.OpenRecordset("tbl_CadComprasPgto")
    rsComprasPgto.AddNew
        rsComprasPgto!COD_ME_tbl_CadCompras = regAtual
        rsComprasPgto!NUM_PARCELA = nParc
        rsComprasPgto!DATA_PREV_PGTO = separaEntreDuasStringsXML(cDup, "<dVenc>", "</dVenc>")
        rsComprasPgto!VALOR_PARCELA = Replace(separaEntreDuasStringsXML(cDup, "<vDup>", "</vDup>"), ".", ",")
        rsComprasPgto!TIPO_PGTO = xTipo
    rsComprasPgto.Update
    rsComprasPgto.Close

    Set rsComprasPgto = Nothing
        '**********Add 1 unidade ao contador para pegar o proximo boleto**********
    d = d + 1
    nParc = nParc + 1
    Next

    Set rsParcela = DB.OpenRecordset("select QTDE_PARCELA, COD_tbl_CadCompras from tbl_CadCompras where COD_tbl_CadCompras = " & regAtual & "")
        
        rsParcela.Edit
        rsParcela("QTDE_PARCELA") = nParc - 1
        rsParcela.Update
        rsParcela.Close

    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

    Conteúdo patrocinado


    [Resolvido]Erro ao importar XML Empty Re: [Resolvido]Erro ao importar XML

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 4/11/2024, 18:31