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

    [Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas

    DFROBINSON
    DFROBINSON
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 61
    Registrado : 21/04/2012

    [Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas Empty [Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas

    Mensagem  DFROBINSON Qua 03 Fev 2016, 4:20 pm

    Amigos do forum!
    Tenho a seguinte situação:
    - tblProtocolos, tblSessoesDoProtocolo e tblProcedimentosDaSessãodoProtocolo devidamente relacionadas entre si (1 para vários);
    - tblTratamentos, tblSessoesDoTratamento e tblProcedimentosDasessãoDoTratamento, igualmente relacionadas entre si (1 para vários);
    A tblTratamentos tem o IdDoProtocolo e, partir desse Id, eu gostaria replicar os registros filho da tblProtocolos como filhos da tblTratamentos;
    Em suma, o conjunto de tabelas "Protocolo" é um modelo padrão a ser utilizado quando o "Tratamento" é cadastrado.
    Agradeço qualquer sugestão de caminho a ser seguido para conseguir o intento.
    Desde já agradeço.


    Última edição por DFROBINSON em Ter 09 Fev 2016, 10:55 am, editado 1 vez(es)
    DFROBINSON
    DFROBINSON
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 61
    Registrado : 21/04/2012

    [Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas Empty Re: [Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas

    Mensagem  DFROBINSON Ter 09 Fev 2016, 10:45 am

    Prezados amigos do forum.
    Depois de algumas pesquisas, encontrei uma solução que, não sei se é a melhor, mas deu certo. Segue a rotina utilizada:


    Código:

    Private Sub cmdGeraSessoes_Click()

       On Error GoTo Err_Handler

       If Me.Dirty Then
           Me.Dirty = False 'Salva os dados do formulário e cria o Id do novo tratamento
       End If
       
       
       Dim intIdDoTratamento, intIdDoProtocolo, intIdSesDoProtocolo, intIdDaSesDoTrat As Integer
       Dim db As DAO.Database
       Dim rsDe As DAO.Recordset   'tblSessoesDoProtocolo
       Dim rsPara As DAO.Recordset 'tblSessoesDoTratamento
       Dim strSql As String
       
       intIdDoTratamento = Me.Id           'o IdDoTratamento recém criado será gravado como campo relacionado na tblSessoesDoTratamento
       intIdDoProtocolo = Me.IdProtocolo   'o IdDoProtocolo será usado para selecionar os registros da tblSessoesDoProtocolo que serão
                                           'duplicados na tblSessoesDoTratamento
       datDataIniTrat = Me.txtDataIniTrat  'a data de início previsto para o tratamento será gravado na primeira sessão do tratamento
                                           'as datas das demais sessões serão serão incrementadas com os "dias para próxima sessão"
                                           'gravadas em cada sessão do protocolo
       
      'montagem do comando SQL que irá selecionar todos as sessões do protocolo informado no form de cadastro do tratamento
       strSql = "SELECT * FROM tblSessoesDoProtocolo WHERE IdDoProtocolo = " & intIdDoProtocolo & ""

       Set db = CurrentDb()
       Set rsDe = db.OpenRecordset(strSql) 'cria o recordset das sessões do protocolo com base no IdDoProtocolo
       Set rsPara = db.OpenRecordset("SELECT * FROM tblSessoesDoTratamento") 'cria o recordset das sessões do tratamento
                                                                             'que receberá as novas sessões copiadas do rsDe
      'Loop entre cada sessão contida no recordset de origem
       Do While Not rsDe.EOF
           [code][/code]
           rsPara.AddNew
           
           intIdDaSesDoTrat = rsPara!Id 'identifica o Id da nova sessão do tratamento que está sendo criada
                                        ' esse Id será usado como campo relacionado na criação dos procedimentos da sessão
           
           rsPara!IdDoTratamento = intIdDoTratamento
           rsPara!NomeDaSessao = rsDe!NomeDaSessao
           rsPara!DataPrevista = datDataIniTrat
           rsPara!DiasProxSessao = rsDe!DiasProximaSessao
           rsPara.Update
           
                   
           intIdSesDoProtocolo = rsDe!Id
           
          'seleciona os registros dos procedimentos da sessão do protocolo recem duplicada e insere na tblProcedDaSessaoDoTrat
           strSql = "INSERT INTO tblProcedDaSessaoTrat (IdDaSesDoTrat, OrdemSeq, Tipo, IdInsumo, DoseMgM2DoProtocolo) " & _
                           "SELECT " & intIdDaSesDoTrat & " As IdSesDoProtocolo, OrdemSeq, Tipo, IdInsumo, DosagemMgM2 " & _
                           "FROM tblProcedDaSessaoProt WHERE IdSesDoProtocolo = " & intIdSesDoProtocolo & ";"
           
          'cria o conjunto de registros definido na instrução SQL
           DBEngine(0)(0).Execute strSql, dbFailOnError
           
          'incrementa a data prevista da próxima sessão a ser gravada
           datDataIniTrat = datDataIniTrat + rsDe!DiasProximaSessao
           
           rsDe.MoveNext
           
       Loop

       rsDe.Close
       rsPara.Close
       Set rsDe = Nothing
       Set rsPara = Nothing
       Set db = Nothing

      'atualiza os subformulários
       Me.[sfrmSessoesDoTratamento].Requery

    Exit_Handler:
       Exit Sub

    Err_Handler:
       MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
       Resume Exit_Handler

    End Sub

      Data/hora atual: Qua 07 Dez 2022, 7:01 pm