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]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

    avatar
    alexjc
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 78
    Registrado : 23/02/2016

    [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir Empty [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

    Mensagem  alexjc 26/9/2022, 23:22

    Boa Noite a Todos !

    Estou precisando tranferir os dados de duas tabelas para uma terceira tabela,
    Isso que estou necessitando é por causa que quando eu importo uma XML ela vem cheio de tabelas, onde queria fazer a ligação dos produtos com a chave na nota entende
    Exemplo
    tb_OrigemA -------- tem apenas um registro
    Campo1
    Linha1_A

    tb_OrigemB ----------- tem VARIOS registros
    Campo1
    Linha1_B
    Linha2_B
    Linha3_B
    Linha4_B

    tb_Destino -------------- teria que vir os dados assim
    Campo1 Campo2
    Linha1_A Linha1_B
    Linha1_A Linha2_B
    Linha1_A Linha3_B
    Linha1_A Linha4_B
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8272
    Registrado : 05/11/2009

    [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir Empty Re: [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

    Mensagem  Alexandre Neves 27/9/2022, 19:24

    Boa tarde
    Qual relação entre os campos da importação?


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    alexjc
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 78
    Registrado : 23/02/2016

    [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir Empty Re: [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

    Mensagem  alexjc 28/9/2022, 01:20

    ai esta o problema em uma tabelas a ha vários produtos e nas outras o cabeçaria porem nenhuma tem informações semelhantes
    avatar
    alexjc
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 78
    Registrado : 23/02/2016

    [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir Empty Re: [Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

    Mensagem  alexjc 28/9/2022, 03:30

    Pessoal consegui escrever o código que eu desejava depois de 4 dias,
    1º - criei um tabela onde receberia os dados da nota menos os produtos
    2º - criei uma outra tabela que receberia os dados dos produtos
    nessas duas tabelas eu inclui a Chave NF-e assim consigo relacioná-las, o código fico grande mas caso alguém necessite esta ai



    '========================= Listar Nomes dos Arquivos da Pasta ======
    'Verifica todos os arquivos .xml
    Dim VarArquivo As String
    VarArquivo = dir(Me.txt_Pasta & "\*.xml", vbArchive) 'txt_Pasta é o caminho dos arquivos
    'Adiaciona todos na lista com o nome de ListaArq
    Do While VarArquivo <> ""
    ListaArq.AddItem (VarArquivo)
    VarArquivo = dir
    Loop
    '============================================================
    'Conta Total de Arquivos da Lista
    Dim Tot_Arq As String
    Tot_Arq = Me.ListaArq.ListCount()
    'pega o nome um por um e vai jogando em uma variavel de nome "e"
    Dim i As Long
    Dim e As Long
    e = 0

    For i = 0 To Tot_Arq - 1
    Dim nometemp As String
    nometemp = Me.ListaArq.ItemData(e)
    Me.txt_NomeArq = nometemp 'vai jogando o nome para o campo txt_NomeArq

    Dim ArqSele As String
    ArqSele = ListaArq.ItemData(e) 'variavel que pega o nome do arquivo selecionado



    '=================================== Importa a XML com dados e estruturas ==================================================================
    On Error Resume Next
    Dim dirXML As Variant
    dirXML = Me.txt_Pasta & Me.txt_NomeArq

    Application.ImportXML _
    DataSource:=dirXML, _
    ImportOptions:=acStructureAndData
    Me.Requery

    '================================== Transfere os Dados Para Juntar em uma unica tabelas os dados do cabeçario ============
    ' Com excessão dos produtos o resta vai tudo para essa tabela
    On Error Resume Next
    Dim BD_Cabecario As DAO.Database 'Cria a Conexão com o Banco de Dados
    Dim TB_NFe As DAO.Recordset 'Cria a Conexão com a Tabela
    Dim TB_NFe_Produtos As DAO.Recordset
    Dim TB_Prod As DAO.Recordset
    Dim TB_Chave As DAO.Recordset
    Dim TB_Emit As DAO.Recordset
    Dim TB_Dest As DAO.Recordset

    Set BD_Cabecario = CurrentDb 'referencia o banco de dados
    Set TB_NFe = BD_Cabecario.OpenRecordset("tb_XML_NFe")
    Set TB_NFe_Produtos = BD_Cabecario.OpenRecordset("tb_XML_NFe_Produtos")
    Set TB_Prod = BD_Cabecario.OpenRecordset("prod")
    Set TB_Chave = BD_Cabecario.OpenRecordset("infProf")
    Set TB_Emit = BD_Cabecario.OpenRecordset("emit")
    Set TB_Dest = BD_Cabecario.OpenRecordset("dest")

    'Inclui informações de apenas uma linha
    TB_NFe.AddNew 'Comando que esta sendo execuldado de adicionar, se foce para deletar seria TB.Delete
    TB_NFe!Chave = DLookup("chNFe", "infProt", "chNFe <> '0'")
    TB_NFe!NF = DLookup("nNF", "ide", "nNF <> '0'")
    TB_NFe!Nome_Emit = DLookup("xNome", "emit", "xNome <> '0'")
    TB_NFe!CNPJ_Emit = DLookup("CNPJ", "emit", "CNPJ <> '0'")
    TB_NFe!IE_Emit = DLookup("IE", "emit", "IE <> '0'")
    TB_NFe!CRT_Emit = DLookup("CRT", "emit", "CRT <> '0'") ' não esta puxando
    TB_NFe!UF_Emit = DLookup("UF", "emit", "UF <> '0'") ' não esta puxando

    TB_NFe!Nome_Dest = DLookup("xNome", "dest", "xNome <> '0'")
    TB_NFe!CNPJ_Dest = DLookup("CNPJ", "dest", "CNPJ <> '0'")
    TB_NFe!CPF_Dest = DLookup("CPF", "dest", "CPF <> '0'")
    TB_NFe!IE_Dest = DLookup("IE", "dest", "IE <> '0'")
    TB_NFe!UF_Dest = DLookup("UF", "dest", "UF <> '0'") ' não esta puxando


    TB_NFe.Update ' atualiza os registros





    '=================================================== PRODUTOS ==========================================
    'Loop Simples para os produtos com chave
    Dim tot_tb As String
    tot_tb = DCount("[xProd]", "prod") 'Contar o total de registro para o loop
    MsgBox (tot_tb)

    Dim a As Long
    DoCmd.GoToRecord , "", acFirst ' vai para o primeiro registro

    For a = 1 To tot_tb Step 1

    TB_NFe_Produtos.AddNew
    TB_NFe_Produtos!Desc_Prod = TB_Prod!xProd
    TB_NFe_Produtos!NCM_Prod = TB_Prod!NCM
    TB_NFe_Produtos!CFOP_Prod = TB_Prod!CFOP
    TB_NFe_Produtos!Quant_Prod = TB_Prod!qCom


    TB_NFe_Produtos!CH_Prod = DLookup("chNFe", "infProt", "chNFe <> '0'")
    TB_NFe_Produtos.Update
    TB_Prod.Update
    TB_Chave.Update

    TB_NFe_Produtos.MoveNext
    TB_Prod.MoveNext
    TB_Chave.MoveNext
    Next


    'fecha as conexões
    TB_NFe.Close
    Set TB_NFe = Nothing
    BD_Cabecario.Close
    Set BD_Cabecario = Nothing

    TB_NFe_Produtos.Close
    Set TB_NFe_Produtos = Nothing
    TB_Prod.Close
    Set TB_Prod = Nothing
    TB_Chave.Close
    Set TB_Chave = Nothing
    TB_Emit.Close
    Set TB_Emit = Nothing
    TB_Dest.Close
    Set TB_Dest = Nothing



    '================================== Deleta as tabelas, para poder importar aproxima =========================================================
    On Error Resume Next
    DoCmd.DeleteObject acTable, "autXML"
    DoCmd.DeleteObject acTable, "COFINSAliq"
    DoCmd.DeleteObject acTable, "COFINSNT"
    DoCmd.DeleteObject acTable, "dest"
    DoCmd.DeleteObject acTable, "det"
    DoCmd.DeleteObject acTable, "detPag"
    DoCmd.DeleteObject acTable, "dup"
    DoCmd.DeleteObject acTable, "emit"
    DoCmd.DeleteObject acTable, "enderDest"
    DoCmd.DeleteObject acTable, "enderEmit"
    DoCmd.DeleteObject acTable, "fat"
    DoCmd.DeleteObject acTable, "ICMS00"
    DoCmd.DeleteObject acTable, "ICMS20"
    DoCmd.DeleteObject acTable, "ICMS60"
    DoCmd.DeleteObject acTable, "ICMS70"
    DoCmd.DeleteObject acTable, "ICMSTot"
    DoCmd.DeleteObject acTable, "ide"
    DoCmd.DeleteObject acTable, "importarError"
    DoCmd.DeleteObject acTable, "imposto"
    DoCmd.DeleteObject acTable, "infAdic"
    DoCmd.DeleteObject acTable, "infProt"
    DoCmd.DeleteObject acTable, "infRespTec"
    DoCmd.DeleteObject acTable, "IPI"
    DoCmd.DeleteObject acTable, "IPINT"
    DoCmd.DeleteObject acTable, "obsCont"
    DoCmd.DeleteObject acTable, "PISAliq"
    DoCmd.DeleteObject acTable, "PISNT"
    DoCmd.DeleteObject acTable, "prod" 'essa não sera deletada, pelo menos por enquanto
    DoCmd.DeleteObject acTable, "Reference"
    DoCmd.DeleteObject acTable, "Signature"
    DoCmd.DeleteObject acTable, "Signedinfo"
    DoCmd.DeleteObject acTable, "Transforms"
    DoCmd.DeleteObject acTable, "transp"
    DoCmd.DeleteObject acTable, "vol"
    DoCmd.DeleteObject acTable, "X509Data"


    MsgBox (ArqSele) ' mensagem apenas para teste

    e = i + 1
    Next i

      Data/hora atual: 27/1/2023, 05:16