[Resolvido]Inserir dados de tabela em subformulário

Bom dia pessoal, preciso inserir dados da tblProtocolosQT no subformulario (frmItensDaPrescricao) dos pacientes.
Preciso que insira todos os medicamentos cuja coluna "Protocolo" na tblProtocolosQT seja igual a "cboProtocolos" do formulario (no evento antes de atualizar). Esses medicamentos do protocolo devem ficar gravados para cada paciente .(deve se relacionar com codigoPaciente.
obs: um protocolo tipo chamado Folfox é formado por vários medicamentos e suas respectivas doses e dosagens.
Coloquei a clausula Where nesse código mas não consegui.

Private Sub cboProtocolo_BeforeUpdate(Cancel As Integer)
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String
'Tabela de destino
Sel1 = "Select * From tblItensDaPrescricao "
Set rst1 = CurrentDb.OpenRecordset(Sel1)
'Tabela de origem
Sel2 = "Select * From tblProtocolosQT Where Protocolo = cboProtocolo "
Set rst2 = CurrentDb.OpenRecordset(Sel2)
Do While Not rst2.EOF
rst1.AddNew
rst1![Medicamento] = rst2![Medicamento]
rst1![Quantidade] = rst2![Quantidade]
rst1![Posologia] = rst2![Posologia]
rst1![Via] = rst2![Via]

rst1.Update

rst2.MoveNext
Loop
rst2.Close
rst1.Close

End Sub

https://www.dropbox.com/s/p9y6pzfah3gap5d/Banco%20de%20dados1.accdb?dl=0

Boa noite. Só vincular o sub com o codigo do paciente.
O codigo do paciente tem que está na sub.
Um pequena exemplo

Bom dia! primeiramente obrigado por compartilhar seus tempos e conhecimentos.
Desculpem a demora na resposta , estava tentando ajustar o sistema.
REalizei vários ajustes e o código evoluiu, mas, esta parando em "update"
Não consigo descobrir porque o código não evolui, se puderem me ajudar, obrigado!

https://www.dropbox.com/s/p54ssxd2hj7tgb2/Prescri%C3%A7%C3%A3o%20teste.accdb?dl=0

Pessoal fiz varias modificaçoes mas o codigo da cbobox (cboInserirProtocolo)trava no update
Pede para relacionar tabela tblPrescricao mas não parece tao simples
Gostaria que esse codigo (ao clicar na cboInserirProtocolo) inserisse registros da tabela tblItensProtocolo para tblItensPrescricao Where Protocolo ='" & cboInsereProtocolo & "'"
Nao sei se o codigo insere todos os itens das linhas Where Protocolo ='" & cboInsereProtocolo & "'"
TAmbem precisa inserir o Id na tblItensPrecricao que seria o mesmo do sub formulario ativo (tblPrescricao) porque sao tabelas relacionadas, nao sei como faz , faz muito tempo que estou tentando.
Posto o sistema de interesse.

Private Sub cboInsereProtocolo_BeforeUpdate(Cancel As Integer)
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String
'Tabela de destino
Sel1 = "Select * From tblItensPrescricao "
Set rst1 = CurrentDb.OpenRecordset(Sel1)
'Tabela de origem
Sel2 = "Select * From tblItensProtocolo Where Protocolo ='" & cboInsereProtocolo & "'"
Set rst2 = CurrentDb.OpenRecordset(Sel2)
Do While Not rst2.EOF
rst1.AddNew
rst1![PROTOCOLO] = rst2![PROTOCOLO]
rst1![Medicamento] = rst2![Medicamento]
rst1![Dose] = rst2![Dose]
rst1![Via] = rst2![Via]

rst1.Update

rst2.MoveNext
Loop
rst2.Close
rst1.Close
End Sub


https://www.dropbox.com/s/0z0585ww6ca9u8p/Banco%20de%20dados21.accdb?dl=0

substitua o seu codigo por este e mude o local do evento da cmbox para depois de atualizar


DoCmd.RunCommand acCmdSaveRecord 'Salvo o Registro antes de começar a selecionar os dados
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String

'Tabela de destino
Sel1 = "Select * From tblItensPrescricao "
Set rst1 = CurrentDb.OpenRecordset(Sel1)
'Tabela de origem
Sel2 = "Select * From tblItensProtocolo Where Protocolo ='" & cboInsereProtocolo & "'"
Set rst2 = CurrentDb.OpenRecordset(Sel2)
Do While Not rst2.EOF

rst1.AddNew
'2 cria o vinculo com a tabela tblItensPrescricao
rst1![IDPrescricao] = Forms!frmPrescricao.subFrmPrescricao!IDPrescricao 'Linha adcionada
rst1![Protocolo] = rst2![Protocolo]
rst1![Medicamento] = rst2![Medicamento]
rst1![Dose] = rst2![Dose]
rst1![Via] = rst2![Via]

rst1.Update

rst2.MoveNext
Loop
rst2.Close
rst1.Close
'3 atualiza o subfrm
Me.subFrmItensPrescricao.Requery 'Linha adcionada
End Sub

Scandinavo, sua inteligência supera os caminhos da lógica, eu agradeço muitissimo por compartilhar seu conhecimento aqui, que nos engrandece, engrandece nosso conhecimento e nossa evolução, engrandesse esse forum que contribui imenssamente ao conhecimento e ao desenvollvimento de nossa inteligência e dessa maravilha que são os sitemas.
Mais uma vez obrigado.
Heldenrson Foletto, oncologista.

Postarei com uma modificação do Layout do subformulario das caixas de texto mudo para combinação, para quem tiver interesse.

https://www.dropbox.com/s/0z0585ww6ca9u8p/Banco%20de%20dados21.accdb?dl=0

Valeu pelo elogio,
um vai ajudando o outro, assim todos evoluímos.


Ate mais