[Resolvido]Copiar registros entre dois conjuntos de tabelas relacionadas

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.

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