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

2 participantes

    [Resolvido]Função DLookup com Erro

    avatar
    RegisBorda
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 07/02/2014

    [Resolvido]Função DLookup com Erro Empty [Resolvido]Função DLookup com Erro

    Mensagem  RegisBorda 1/10/2021, 15:44

    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:.
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8025
    Registrado : 05/11/2009

    [Resolvido]Função DLookup com Erro Empty Re: [Resolvido]Função DLookup com Erro

    Mensagem  Alexandre Neves 2/10/2021, 09:33

    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


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    RegisBorda
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 07/02/2014

    [Resolvido]Função DLookup com Erro Empty Função DLookup com Erro

    Mensagem  RegisBorda 2/10/2021, 20:51

    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
    avatar
    RegisBorda
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 07/02/2014

    [Resolvido]Função DLookup com Erro Empty Função DLookup com Erro

    Mensagem  RegisBorda 5/10/2021, 12:10

    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

      Data/hora atual: 16/10/2021, 22:19