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 Xml Lote "Importar Duplicata"

    Compartilhe

    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 414
    Registrado : 30/08/2010

    [Resolvido]Importar Xml Lote "Importar Duplicata"

    Mensagem  NADIRONUNES em Sex 24 Fev 2017, 4:24 pm

    boa tarde preciso importar as duplicatas e parte do frete da xml usando o codigo do FabioPaes

    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, "", ""), ".", ",")
    'Valor Liquido "Valor Bruto-descontos"
    rsCompra!ValorNFL = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")

    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, "", "") & "'"), 0)
    If x <= 0 Then
    'Cadastra o Produto, pois ainda nao foi cadastrado
    Set rsProd = DB.OpenRecordset("tbCadProd")
    rsProd.AddNew
    rsProd!DescProd = separaEntreDuasStringsXML(xProd, "", "")
    rsProd!Unid = separaEntreDuasStringsXML(xProd, "", "")
    rsProd!Estoque = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    rsProd.Update
    x = Nz(DLookup("IdProd", "tbCadProd", "DescProd = '" & separaEntreDuasStringsXML(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, "", ""), ".", ",")
    rsCompDet!ValorUnit = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    rsCompDet!ValorTot = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    rsCompDet!ICMS = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    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, "", ""), ".", ",")
    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, "", ""), ".", ",") 'O replace e utilizado para substituir o . por ,
    rsCompDet!ValorUnit = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    rsCompDet!ValorTot = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",") * Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
    rsCompDet!ICMS = Nz(Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ","), 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
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Importar Xml Lote "Importar Duplicata"

    Mensagem  FabioPaes em Sex 24 Fev 2017, 6:04 pm

    Amigo, para importar as Duplicatas de cada XML, deverá fazer o mesmo que foi feito com os Produtos.

    Veja que nessa Linha, (   xProd = doc.getElementsByTagName("det")(i).XML    ) eu Desmembro o XML buscando os produtos tag . Como pode ter mais de um produto eu realizo o desmembramento informando a posição que quero (de 0 a xxx) pegando o valor da variável i ( (i).XML ). Assim a medida que e realizado o Loop eu irei descendo e pegando produto a aproduto. produto 0, 1, 2...

    Veja a Imagem a baixo:

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


    Quanto ao Transporte e mais simples, pois é Unico... Então basta realizar a extração dos dados conforme realizei com os dados do Fornecedor...
    Veja onde estão os dados:
    [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!

    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 414
    Registrado : 30/08/2010

    Re: [Resolvido]Importar Xml Lote "Importar Duplicata"

    Mensagem  NADIRONUNES em Sex 24 Fev 2017, 6:49 pm

    obrigado FabioPaes

    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 414
    Registrado : 30/08/2010

    Re: [Resolvido]Importar Xml Lote "Importar Duplicata"

    Mensagem  NADIRONUNES em Sex 28 Abr 2017, 11:34 pm

    como que busco  nesta xml  onde  tem o 799
    Anexos
    doc41823022000139_FCFBSX42M41NRUS2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (1 Kb) Baixado 10 vez(es)

      Data/hora atual: Seg 25 Set 2017, 9:48 am