[Resolvido]Função DLookup com Erro

Prezados,

Bom dia, tudo bem ?

Estou com um probleminha.

Tenho uma tabela de consultas com CodMedico, HoraConsulta, DtConsulta, etc

Tenho um Form (Monta Agenda de Consultas) neste form eu coloco os critérios para montar a agenda como :

CodMedico =1
Data da Consulta = 03/12/2021
Hora Inicial : 7:00
Hora Final : 16:30
Intervalo entre consultas : 30 minutos

No mês de dezembro não tem nenhuma agenda montada. Gostaria de montar a agenda para o dia 03/12/2021 e no código a seguir, está dando ERRO no Dlookup que busca a data do dia 03/12/2021 que não existe tem que apresentar (VAZIO). O mesmo está trazendo 12/03/2021 que existe na tabela de consultas, logo ele diz "Que já possui Agenda para este dia". Como poderia resolver isso ?

Private Sub Comando27_Click()
On Error GoTo Err_Comando27_Click
If IsNull([CodMedico]) Then
  MsgBox "Você deve informar o Código do Médico !!!", , "Erro de CRM"
  DoCmd.GoToControl "CodMedico"
Else
  If IsNull([DtEmissaoInicial]) Then
     MsgBox "Você deve informar o Dia da Consulta !!!", , "Erro de Data"
     DoCmd.GoToControl "DtEmissaoInicial"
  Else
     If IsNull([HoraInicial]) Then
        MsgBox "Você deve informar a Hora Inicial da Consulta !!!", , "Erro de Hora"
        DoCmd.GoToControl "HoraInicial"
     Else
        If IsNull([HoraFinal]) Then
           MsgBox "Você deve informar a Hora Final da Consulta !!!", , "Erro de Hora"
           DoCmd.GoToControl "HoraFinal"
        Else
           If IsNull([Intervalo]) Then
              MsgBox "Você deve informar o Intervalo em Minutos entre as Consultas !!!", , "Erro de Intervalo"
              DoCmd.GoToControl "Intervalo"
           Else
              Dim horaAtual As Date
              Dim rstD As DAO.Recordset
              CurCRMMedico = Nz(DLookup("[CodCliente]", "Cadastro de Consultas", " [CodCliente]=" & Me.CodMedico))
              CurDtConsulta = Nz(DLookup("[DtadaConsulta]", "Cadastro de Consultas", " [DtadaConsulta]=#" & Forms!FormMontaAgenda!DtEmissaoInicial & "#")) ===> está trazendo 12/03/2021 e não VAZIO pois 03/12/2021 não tem na tabela.
              If CurCRMMedico = 1 And IsNull(CurDtConsulta) = True Then
                 Set rstD = CurrentDb.OpenRecordset("Cadastro de Consultas")
                 With rstD
                      horaAtual = Me!HoraInicial
                      Do While Not Me!HoraFinal < horaAtual
                         .AddNew
                         rstD!CodCliente = Me.CodMedico
                         rstD!DtadaConsulta = Me.DtEmissaoInicial
                         rstD!HoradaConsulta = horaAtual
                         .Update
                         horaAtual = DateAdd("n", Me!Intervalo, horaAtual)
                      Loop
                 End With
                 rstD.Close
                 Set rstD = Nothing
                 Me.Refresh
                 MsgBox "Agenda de Consultas montada com sucesso !!!", , "Monta Agenda"
              Else
                 MsgBox "Agenda de Consultas já existe para esse dia !!!", , "Monta Agenda"
              End If
           End If
        End If
     End If
  End If
End If

Exit_Comando27_Click:
   Exit Sub

Err_Comando27_Click:
   MsgBox Err.Description
   Resume Exit_Comando27_Click
   
End Sub

Muito Grato,

Abs,

Regis Borda:.

Bom dia
Para solucionar a confusão entre 03/12/2021 e 12/03/2021 é devido à famosa formatação americana e as definições regionais do computador
Use a função Format(...,"dd-mm-yyyy") para trabalhar com as datas pretendidas

Prezados,

Consegui descobrir o Erro.

CurDtConsulta = Nz(DLookup("[DtadaConsulta]", "Cadastro de Consultas", " [DtadaConsulta]=#" & Forms!FormMontaAgenda!DtEmissaoInicial & "#"))

O nome do segundo campo após "Cadastro de Consultas" é na verdade [DtEmissaoInicial] então ficou assim o Código :

Private Sub Comando27_Click()
On Error GoTo Err_Comando27_Click
If IsNull([CodMedico]) Then
MsgBox "Você deve informar o Código do Médico !!!", , "Erro de CRM"
DoCmd.GoToControl "CodMedico"
Else
If IsNull([DtEmissaoInicial]) Then
MsgBox "Você deve informar o Dia da Consulta !!!", , "Erro de Data"
DoCmd.GoToControl "DtEmissaoInicial"
Else
If IsNull([HoraInicial]) Then
MsgBox "Você deve informar a Hora Inicial da Consulta !!!", , "Erro de Hora"
DoCmd.GoToControl "HoraInicial"
Else
If IsNull([HoraFinal]) Then
MsgBox "Você deve informar a Hora Final da Consulta !!!", , "Erro de Hora"
DoCmd.GoToControl "HoraFinal"
Else
If IsNull([Intervalo]) Then
MsgBox "Você deve informar o Intervalo em Minutos entre as Consultas !!!", , "Erro de Intervalo"
DoCmd.GoToControl "Intervalo"
Else
Dim horaAtual As Date
Dim rstD As DAO.Recordset
CurCRMMedico = Nz(DLookup("[CodCliente]", "Cadastro de Consultas", " [CodCliente]=" & Me.CodMedico))
CurDtConsulta = Nz(DLookup("[DtadaConsulta]", "Cadastro de Consultas", " [DtEmissaoInicial]=#" & Forms!FormMontaAgenda!DtEmissaoInicial & "#"))
If CurCRMMedico = 1 And CurDtConsulta = 0 Then
Set rstD = CurrentDb.OpenRecordset("Cadastro de Consultas")
With rstD
horaAtual = Me!HoraInicial
Do While Not Me!HoraFinal < horaAtual
.AddNew
rstD!CodCliente = Me.CodMedico
rstD!DtadaConsulta = Me.DtEmissaoInicial
rstD!HoradaConsulta = horaAtual
.Update
horaAtual = DateAdd("n", Me!Intervalo, horaAtual)
Loop
End With
rstD.Close
Set rstD = Nothing
Me.Refresh
MsgBox "Agenda de Consultas montada com sucesso !!!", , "Monta Agenda"
Else
MsgBox "Agenda de Consultas já existe para esse dia !!!", , "Monta Agenda"
End If
End If
End If
End If
End If
End If

Exit_Comando27_Click:
Exit Sub

Err_Comando27_Click:
MsgBox Err.Description
Resume Exit_Comando27_Click

End Sub

De qualquer forma grato, pela Ajuda.

Abs,

Regis

Prezados,

Acertei alguns campos que estavam errados porém a Função DLookup ainda não estavam funcionando bem.

Fiz acertos no código utilizando a busca via consulta fiz alguns testes e acho que desta vez funcionou.

Segue o código completo :

Private Sub MontaAgenda_Click()
On Error GoTo Err_MontaAgenda_Click
If IsNull([CodMedico]) Then
MsgBox "Você deve informar o Código do Médico !!!", , "Erro de CRM"
DoCmd.GoToControl "CodMedico"
Else
If IsNull([DtEmissaoInicial]) Then
MsgBox "Você deve informar o Dia da Consulta !!!", , "Erro de Data"
DoCmd.GoToControl "DtEmissaoInicial"
Else
If IsNull([HoraInicial]) Then
MsgBox "Você deve informar a Hora Inicial da Consulta !!!", , "Erro de Hora"
DoCmd.GoToControl "HoraInicial"
Else
If IsNull([HoraFinal]) Then
MsgBox "Você deve informar a Hora Final da Consulta !!!", , "Erro de Hora"
DoCmd.GoToControl "HoraFinal"
Else
If IsNull([Intervalo]) Then
MsgBox "Você deve informar o Intervalo em Minutos entre as Consultas !!!", , "Erro de Intervalo"
DoCmd.GoToControl "Intervalo"
Else
Dim horaAtual As Date
Dim rstD As DAO.Recordset
Dim rst As DAO.Recordset
DoCmd.SetWarnings False
DoCmd.OpenQuery "ConsBuscaDataMontaAgenda", acViewNormal
Set db = CurrentDb()
Set rst = db.OpenRecordset("TbBuscaDataAgenda")
If rst.RecordCount = 0 Then
Set rstD = CurrentDb.OpenRecordset("Cadastro de Consultas")
With rstD
horaAtual = Me!HoraInicial
Do While Not Me!HoraFinal < horaAtual
.AddNew
rstD!CodCliente = Me.CodMedico
rstD!DtadaConsulta = Me.DtEmissaoInicial
rstD!HoradaConsulta = horaAtual
.Update
horaAtual = DateAdd("n", Me!Intervalo, horaAtual)
Loop
End With
rstD.Close
Set rstD = Nothing
rst.Close
Set rst = Nothing
Me.Refresh
MsgBox "Agenda de Consultas montada com sucesso !!!", , "Monta Agenda"
DoCmd.DeleteObject acTable, "TbBuscaDataAgenda"
Else
rst.Close
Set rst = Nothing
MsgBox "Agenda de Consultas já existe para esse dia !!!", , "Monta Agenda"
DoCmd.DeleteObject acTable, "TbBuscaDataAgenda"
End If
End If
End If
End If
End If
End If

Exit_MontaAgenda_Click:
Exit Sub

Err_MontaAgenda_Click:
MsgBox Err.Description
Resume Exit_MontaAgenda_Click

End Sub

Grato a todos.

Abs,

Regis Borda