MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Importar dados do destinatário da NF-e xml

    Compartilhe

    esabbag
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 27/07/2010

    [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  esabbag em Sab 15 Abr 2017, 18:13

    Boa tarde

    Estou precisando de auxilio
    Preciso importar os dados do destinatário da NF-e de saida
    Estou usando o código do Fabio Paes.
    Nas notas de entrada dá tudo certo
    Nas de saída os dados importados são os do emitente
    Uso o frmsaida para importar as saidas
     
    [code]Option Compare Database
    Public Function ImportaXMLsaida(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, rsCli, R50_S, R54_S As DAO.Recordset
    Dim xProd As String
    Dim dest As Object
    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")
    Set xDest = doc.getElementsByTagName("dest")
    '------------------------------------------------------------------------'
    'Insere os Dados do Cliente, se nao for Cadastrado.
    For Each dest In xDest
    Set rsCli = DB.OpenRecordset("tbClientes")
    x = Nz(DLookup("IdFor", "tbClientes", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'X buscará o cliente na tabela "tbClientes"
    If x <= 0 Then 'Se x for <=0 significa que nao ta cadastrado, entao irá cadastrar o cliente
       rsCli.AddNew
           rsCli!NomeForn = doc.getElementsByTagName("xNome")(0).Text
           rsCli!CNPJ = separaEntreDuasStringsXML("dest", "<CNPJ>", "</CNPJ>")
       rsCli.Update
    'Apos cadastrar o cliente, x buscara o ID desse fcliente para ser utilizado na importação do xml em questao
    x = Nz(DLookup("IdFor", "tbClientes", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0)
    rsCli.Close
    Set rsClir = Nothing
    End If[
    '------------------------------------------------------------------------'
    'Dados Principais da Nota de Compra (R50_S)
    Set rsR50_S = DB.OpenRecordset("R50_S")
    rsR50_S.AddNew
       rsR50_S!IdFornecedor = x
       rsR50_S!CGC = separaEntreDuasStringsXML("xdest", "<CNPJ>", "</CNPJ>")
       rsR50_S!IE = separaEntreDuasStringsXML("xdest", "<IE>", "</IE>")
       '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
       rsR50_S!EMISSAO = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
       Else
       rsR50_S!EMISSAO = 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
           rsR50_S!VALORTOTAL = Replace(separaEntreDuasStringsXML(xProd, "<vProd>", "</vProd>"), ".", ",")
           'Valor Liquido "Valor Bruto-descontos"
           rsR50_S!xVALORTOTAL = Replace(separaEntreDuasStringsXML(xProd, "<vNF>", "</vNF>"), ".", ",")
                   'Imposto = doc.getElementsByTagName("total")(0).XML
           'Valor BC
           'rsR50_S!BASEICMS = Replace(separaEntreDuasStringsXML(Imposto, "<vBC>", "</vBC>"), ".", ",")
           'Valor ICMS retido
           'rsR50_S!VALORICMS = Replace(separaEntreDuasStringsXML(Imposto, "<vICMS>", "</vICMS>"), ".", ",")
       rsR50_S!MODELO = doc.getElementsByTagName("mod")(0).Text
       rsR50_S!SERIE = doc.getElementsByTagName("serie")(0).Text
       rsR50_S!NUMERO = doc.getElementsByTagName("nNF")(0).Text
       rsR50_S!CFOP = doc.getElementsByTagName("CFOP")(0).Text
       rsR50_S!MODELO = doc.getElementsByTagName("mod")(0).Text
       rsR50_S!SERIE = doc.getElementsByTagName("serie")(0).Text
       rsR50_S!UF = doc.getElementsByTagName("UF")(0).Text
       rsR50_S!ALIQUOTA = Replace(separaEntreDuasStringsXML(xProd, "<pICMS>", "</pICMS>"), ".", ",")
       rsR50_S!ChaveNF = doc.getElementsByTagName("chNFe")(0).Text
       
    rsR50_S.Update
    regAtual = Nz(DLookup("ID", "R50_S", "ChaveNF = '" & doc.getElementsByTagName("chNFe")(0).Text & "'"), 0)

    rsR50_S.Close
    Set rsR50_S = 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!CODCONTRIB = doc.getElementsByTagName("cProd")(0).Text
    rsProd.Update
    x = Nz(DLookup("IdProd", "tbCadProd", "DescProd = '" & separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>") & "'"), 0)
    'Insere o produto cadastrado na Nota de compra
    Set rsR54_S = DB.OpenRecordset("R54_S")
    rsR54_S.AddNew
       rsR54_S!IDCompra = regAtual
       rsR54_S!IDProd = x
       rsR54_S!QTDE = Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
       'rsR54_S!ValorUnit = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",")
       rsR54_S!VALORPRODUTO = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
       rsR54_S!ALIQICMS = Replace(separaEntreDuasStringsXML(xProd, "<pICMS>", "</pICMS>"), ".", ",")
       rsR54_S!CGC = doc.getElementsByTagName("CNPJ")(0).Text
       rsR54_S!NUMERO = doc.getElementsByTagName("nNF")(0).Text
       rsR54_S!MODELO = doc.getElementsByTagName("mod")(0).Text
       rsR54_S!SERIE = doc.getElementsByTagName("serie")(0).Text
       rsR54_S!CFOP = doc.getElementsByTagName("CFOP")(0).Text
       rsR54_S!CST = doc.getElementsByTagName("CST")(0).Text
       rsR54_S!DescProd = separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>")
       If rsR54_S!CST = 60 Then
       rsR54_S!BCICMSSUBS = Replace(separaEntreDuasStringsXML(xProd, "<vBCSTRet>", "</vBCSTRet>"), ".", ",")
       Else
       rsR54_S!BCICMSSUBS = Replace(separaEntreDuasStringsXML(xProd, "<vBCST>", "</vBCST>"), ".", ",")
       End If
       If (doc.getElementsByTagName("dhEmi").length) Then
       rsR54_S!Data = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
       Else
       rsR54_S!Data = Format(doc.getElementsByTagName("dEmi")(0).Text, "dd/mm/yyyy")
       End If
    rsR54_S.Update

    rsR54_S.Close
    rsProd.Close
    Set rsR54_S = 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 rsR54_S = DB.OpenRecordset("R54_S")
    rsR54_S.AddNew
       rsR54_S!IDCompra = regAtual
       rsR54_S!IDProd = x
       rsR54_S!QTDE = Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
       rsR54_S!CODCONTRIB = doc.getElementsByTagName("cProd")(0).Text
       rsR54_S!VALORPRODUTO = Replace(separaEntreDuasStringsXML(xProd, "<vUnCom>", "</vUnCom>"), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "<qCom>", "</qCom>"), ".", ",")
       rsR54_S!ALIQICMS = Replace(separaEntreDuasStringsXML(xProd, "<pICMS>", "</pICMS>"), ".", ",")
       rsR54_S!CGC = doc.getElementsByTagName("CNPJ")(0).Text
       rsR54_S!NUMERO = doc.getElementsByTagName("nNF")(0).Text
       rsR54_S!MODELO = doc.getElementsByTagName("mod")(0).Text
       rsR54_S!SERIE = doc.getElementsByTagName("serie")(0).Text
       rsR54_S!CFOP = doc.getElementsByTagName("CFOP")(0).Text
       rsR54_S!CST = doc.getElementsByTagName("CST")(0).Text
       rsR54_S!DescProd = separaEntreDuasStringsXML(xProd, "<xProd>", "</xProd>")
       If rsR54_S!CST = 60 Then
       rsR54_S!BCICMSSUBS = Replace(separaEntreDuasStringsXML(xProd, "<vBCSTRet>", "</vBCSTRet>"), ".", ",")
       Else
       rsR54_S!BCICMSSUBS = Replace(separaEntreDuasStringsXML(xProd, "<vBCST>", "</vBCST>"), ".", ",")
       End If
       If (doc.getElementsByTagName("dhEmi").length) Then
       rsR54_S!Data = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
       Else
       rsR54_S!Data = Format(doc.getElementsByTagName("dEmi")(0).Text, "dd/mm/yyyy")
       End If
    rsR54_S.Update
    'Limpa os dados do recordset e fecha a conecção
    rsR54_S.Close
    rsProd.Close
    Set rsR54_S = 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!frmSaidas.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
    /code]


    Grato
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  FabioPaes em Sab 15 Abr 2017, 21:33

    Certo amigo, e qual o Problema encontrado?


    .................................................................................
    _____________________________________________________________________
    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!

    esabbag
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 27/07/2010

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  esabbag em Sab 15 Abr 2017, 22:09

    Caro Fabio, quando faço a importação dos dados das NF de saida só importa os dados do emitente no lugar do destinatário - CNPJ, IE, Nome
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  FabioPaes em Sab 15 Abr 2017, 22:30

    Observe as instruções da Imagem a baixo que entenderá!

    [Você precisa estar registrado e conectado para ver esta imagem.]


    .................................................................................
    _____________________________________________________________________
    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!

    esabbag
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 27/07/2010

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  esabbag em Sab 15 Abr 2017, 23:21

    Fabio, está dando um erro de compilação "for sem next", marca o EndSub

    esabbag
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 27/07/2010

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  esabbag em Sab 15 Abr 2017, 23:27

    Fabio
    Problemas resolvidos
    Muito obrigado
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Importar dados do destinatário da NF-e xml

    Mensagem  FabioPaes em Sab 15 Abr 2017, 23:40

    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!

      Data/hora atual: Sab 18 Nov 2017, 19:22