[Resolvido]Como impedir a adição de registro se a data "colidir" com período já digitado?

Senhores, boa tarde.

Numa consulta "qryPacientes" possuo os campos Pront (numérico), Paciente (Texto), DtaInternação (Data/Hora) e DtaSaída (Data/Hora)
Possuo, tambem, um formulário com um subformulário vinculado à esta consulta.
O que pretendo é:
Ao inserir a data de Internação, "DtaInternação" num novo registro, o sistema procure na consulta "qryPacientes" pelo Prontuário do Paciente "Pront" e se verificar que a data da internação "DtaInternação" se encontre entre o período anteriormente inserido exiba uma mensagem de impropriedade e impeça de continuar.

Abraços, a todos e desejo-lhes um Ano Novo repleto de realizações.

WSenna

Olá Rei WSenna;

Boas festas e feliz ano novo para si e seus familiares;

Dê uma testada ae;


Private Sub DtaInternação_BeforeUpdate(Cancel As Integer)
Dim xNome As Integer
If DCount("Pront", "qryPacientes", "Pront = " & Me!Pront & " AND DtaInternação Between #" & Me!DtaInternação & "# AND #" & Me!DtaSaída & "#") > 0 Then
If MsgBox("Este Paciente já foi internado." & Chr(13) & Chr(10) & "Deseja alterar?", vbQuestion + vbYesNo, "Aviso") = vbYes Then
xNome = Me!Pront
Me.Undo
DoCmd.ApplyFilter , "Pront =" & xNome
Else
Cancel = True
Me.Undo
End If
End If
End Sub

Olá Grande JPaulo.

Mestre, eu já havia tentado assim mas sempre deu erro com a mensagem:

Erro em tempo de execução '3075'

Erro de sintax na data na expressão de consulta'Pront=900030
AND DtaInternação Between #07/01/2012# AND ##'.

Mais alguma idéia?

Fico aguardando, abraços WSenna

Testado e a funfar;


Private Sub DtaInternação_BeforeUpdate(Cancel As Integer)
Dim xNome As Integer
If DCount("Pront", "qryPacientes", "DtaInternação>=" & Format(DtaInternação, "dd-mm-yyyy") & " AND DtaSaída >= " & Format(DtaInternação, "dd-mm-yyyy") & " AND Pront = " & Me!Pront & "") > 0 Then
If MsgBox("Este Paciente já foi internado." & Chr(13) & Chr(10) & "Deseja alterar?", vbQuestion + vbYesNo, "Aviso") = vbYes Then
xNome = Me!Pront
Me.Undo
DoCmd.ApplyFilter , "Pront =" & xNome
Else
Cancel = True
Me.Undo
End If
End If
End Sub

Quase lá Mestre.

Agora se seleciono SIM para ir para o registro anterior ocorre o seguinte erro.

Erro em tempo de execução '6':
Estouro

Falta pouco, vai...

Tô de olho.

Quase cheguei lá:

Alterei o código para:

Dim db As DAO.Database
Dim rs As DAO.Recordset
If DCount("Pront", "qryPacientes", "DtaInternação>=" & Format(DtaInternação, "dd-mm-yyyy") & " AND DtaSaída >= " & Format(DtaInternação, "dd-mm-yyyy") & " AND Pront = " & Me!Pront & "") > 0 Then
If MsgBox("Este Paciente já foi internado." & Chr(13) & Chr(10) & "Deseja alterar?", vbQuestion + vbYesNo, "Aviso") = vbYes Then

'Me.Undo

Set rs = Me.RecordsetClone
rs.FindFirst "Pront = " & Me.Pront & ""
Me.Undo
Me.Bookmark = rs.Bookmark
Set rs = Nothing

Else

Cancel = True
Me.Undo
End If
End If
End Sub

Agora o cursor vai para o campo DtaInternação do registro anterior, porém, caso eu digite a data de internação fora do período anterior o sistema não libera, ou seja, apaga o registro recen-criado ou arremete para o registro anterior.

Tá difícil...

Grande JPaulo, C O N S E G U I !!!

Pesquisando aqui e ali encontrei este código que funciona a pleno vapor:

Private Sub DtaInternação_BeforeUpdate(Cancel As Integer)
Dim xNome As Integer

If Year(DtaInternação) <> Me.Ano Or Month(DtaInternação) <> [Numeral] Then
MsgBox "A data que você informou não condiz com o mês de " & Me.MêsRef & ". ", vbCritical, " Atenção"
Cancel = True
End If 'Aqui eu incluí dois campos ocultos Ano e Numeral para avisar ao usuário caso êle digite uma data fora do mês a ser processado.

Dim DB As DAO.Database, RST As DAO.Recordset
Dim SQL As String, X, Reg As Integer

Set DB = CurrentDb()
SQL = "Select * From qryPacientes where Pront =" & Forms!frmMovimento!frmPacientes!Pront ' Por tratar-se de um subform do Form_frmMovimento
Set RST = DB.OpenRecordset(SQL)

Reg = Me.RecordsetClone.RecordCount() 'Total de registros
RST.MoveFirst ' Vou para o primeiro registro
For X = 1 To Reg
With RST
If Not .EOF Then
If Me.DtaInternação >= RST!DtaInternação And Me.DtaInternação <= RST!DtaSaída Then
MsgBox "Esta data consta como internado nesta Unidade. ", vbCritical, "Atenção"
Me.Undo ' Desfaz o registro
End If
.MoveNext
End If
End With
Next X
RST.Close
DB.Close
End Sub

Um grande abraço e um beijo em vosso coração.

WSenna

Como a hora de PT é diferente de BR entretanto tive de sair.
Fico feliz de ter conseguido.
Feliz ano ano para você e sua família.

Valew Mestre.

Como dizia meu saudoso Pai, "A Guarda Morre Mas Não Se Rende, Jamais.", daí o meu lema é "Ir à luta".
Sendo assim, tomei a decisão de publicar nesse tópico o desfecho do problema para que sirva de ajuda para os demais amigos que por ventura tiverem o mesmo problema, e noto que isso é deveras solicitado em todos os Fori que andei pesquisando.

Um grande abraço, e que o Grande Programador lá de cima lhe proporcione um Ano Novo pleno de realizações, com muita saúde e paz.

WSenna