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 cupom fiscal sat xml

    Compartilhe

    esabbag
    Novato
    Novato

    Respeito às Regras 100%

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

    [Resolvido]Importar cupom fiscal sat xml

    Mensagem  esabbag em Dom 16 Abr 2017, 14:36

    Bom dia

    Agora preciso importar os dados do cupom fiscal no access

    Tentei usar o código de importação da NFe do FabioPaes, mas não importa nenhum dado.

    Está dando erro de validação em todos os xml

    Segue o código
    Código:

    Option Compare Database
    Public Function ImportaXMLSaidaEcf(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, rsR60I 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("URI").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!IE = doc.getElementsByTagName("IE")(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 rsR60I = DB.OpenRecordset("R60I")
    rsR60I.AddNew
        rsR60I!IDCompra = regAtual
        rsR60I!IDProd = 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
        rsR60I!xdata = Format(Left(doc.getElementsByTagName("dhEmi")(0).Text, 10), "dd/mm/yyyy")
        Else
        rsR60I!xdata = 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
            rsR60I!ValorProduto = Replace(separaEntreDuasStringsXML(xProd, "<vProd>", "</vProd>"), ".", ",")
            'Valor Liquido "Valor Bruto-descontos"
            rsR60I!valortotal = Replace(separaEntreDuasStringsXML(xProd, "<vCFe>", "</vCFe>"), ".", ",")
        rsR60I!CODCONTRIB = doc.getElementsByTagName("cProd")(0).Text
        rsR60I!NUMDOCUM = doc.getElementsByTagName("nCFe")(0).Text
        rsR60I!ChaveNF = doc.getElementsByTagName("URI")(0).Text
    rsR60I.Update
    regAtual = Nz(DLookup("ID", "rsR60I", "ChaveNF = '" & doc.getElementsByTagName("URI")(0).Text & "'"), 0)

    rsR60I.Close
    Set rsR60I = 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!frmSaidasEcf.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

    Espero que alguém consiga me ajudar
    Grato
    Elias

      Data/hora atual: Sab 23 Set 2017, 06:47