[Resolvido]Verifica e alerta Duplicidade em Formulário e Consulta

Olá caros mestres, que a paz esteja com todos!


Tem várias postagens em relação à esta dúvida, mas daí não consegui desenvolver uma adaptação por, os exemplos alguns expiraram a hospedagem para baixar, etc.. Desculpem, seria um código vba para percorrer 3 campos e comparar os dados,tipo if isnull()...

Se alguem tiver algum exemplo pratico e tiver a bondade de compartilhar o bd, agradeço muito.

tipo, se todos os Dados forem iguais, seria sinalizado com um "msgbox" : já existe agendamento relacionado à este.

Vou postar o link do meu BD para que possam dar uma olhada e quem sabe, me ajudar a desvendar
esse problema, de evitar a que o user final, inserisse novos agendamentos de pacientes repetidos marcado para o mesmo profissional e mesma data.

Formulário questão: "SistemadeMarcações"

campos a percorrer e comparar os Dados: "txtPront"";"" txtUsuario";" txtProf"

O Formulário faz referencia a uma consulta "Cslt_Agendamentos"

Desde já muito grato a todos mais uma vez.


Anexos do BD:

dropbox.com/s/qnqerjtfc3xn7fo/SISGAM.zip?dl=0

"aquele que pergunta é tolo por cinco minutos mas aquele que não pergunta permanece tolo para sempre"

Olá..

Não consegui abrir o seu Bd porque meu access é 2007 e o seu deve ser superior, então não pude testar.

Mas adaptei este código com as informações passadas.

Copie e cole no evento após atualizar do campo txtProf

Código:

Private Sub txtProf_AfterUpdate()
   
    'Ativa rotina de tratamento de erro
    On Error GoTo TrataErro

    'declara variável do tipo recordset
    Dim rst As DAO.Recordset
   
    'seta a variável
    Set rst = Me.RecordsetClone
   
    'compara o registro com o recordset
    rst.FindFirst "[txtPront] ='" & Me!txtPront & "' And [txtUsuario] ='" & Me!txtUsuario & "' And [txtProf] ='" & Me!txtProf & "'"
   
        'verifica se não é fim de arquivo
        If Not rst.NoMatch Then
       
            'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[CodAgendamento]", "Cslt_Agendamentos", "[txtPront] = '" & Me!txtPront & "' and [txtUsuario] = '" & Me!txtUsuario & "'and [txtProf] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[txtPront]", "Cslt_Agendamentos", "[txtPront] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[txtUsuario]", "Cslt_Agendamentos", "[txtUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[txtProf]", "Cslt_Agendamentos", "[txtProf] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
            Else
                Me.Undo
            End If
        End If
   
    'fecha o recordset
    rst.Close
    'libera memoria
    Set rst = Nothing
   
'Tratamento de erro
Exit_Trataerro:
    Exit Sub

TrataErro:
    'exibe mensagem com o erro ocorrido
    MsgBox "Erro número: " & Err.Number & " - " & Err.Description & " (" & Me.Name & " - " & Me.ActiveControl.Name & " - BeforeUpdate).", vbCritical, "Titulo"
    Resume Next
 
End Sub


Se houver algum erro e não consegui corrigir, anexe uma cópia do BD em versão 2007

Aguardo retorno

Abraços

OPS...! Mil Perdões, esqueci que tava com senha o Vba. Muito Obrigado por compartilhar seus conhecimentos Celso! Vou testar aqui e logo volto a comentar o tópico.




Segue em anexo o endereço pra baixar o BD.:

dropbox.com/s/qnqerjtfc3xn7fo/SISGAM.zip?dl=0

Olá..

A minha versão não é compatível com a sua, como eu disse a sua versão deve ser superior ao 2007.

Eu sugeri que você colocasse no evento após atualizar do campo txtProf ,
Mas o correto é no evento após atualizar do ultimo dos três campos a ser preenchido.

Aguardo

Abraços

Vou testar aqui, entendi Celso.

Obrigado , começou a dar certo. Mas só tá utilizando não só o mesmos dados iguais, mas todos os dados q for inserido posteriomente abri a mensagem de Erro, tipo só aceita um agendamento. queir a conseguir limitar ou alertar com vbquestion sim ou nao a prosseguir. mas um caminho é esse muito obrigado.

vou postar o print do tipo do erro:

Olá...

Em sua tabela verifique se existe o campo CodAgendamento

Segue um exemplo para voce se basear

Aguardo Retorno

Abraços

Olá..

Neste código ele não permite manter a duplicidade, se existir um agendamento igual ele te pergunta se voce quer ir ao agendamento original ou não para editar

Abraços

Perfeito exemplo Celso!

Muito Grato, tenho certeza que com este exemplo conseguirei adaptar ao meu BD.

Vou testar aqui, logo posto novidades.

Muito obrigado mesmo!

Olá Celso Bom dia! Tudo bem?

Está dando certo, é exatamente isso que precisava, devido a não compreender muito esse código queria pedir sem querer abusar sua gentileza, readaptar os nomes das tabelas no cód vba, devido eu não compreender tanto esse código de busca, pois minhas tabelas no BD, tem outros nomes, quando eu fiz a adaptação apresentou alguns erros, até fez a execução, mas efim. vou anexar o Exemplo que vc me passou, com as tabelas renomeadas, daí creio que poderá me ajudar a modificar o nome das tabelas no código Vba.


Nome dos campos na tabela: Cod_agendamentos, Prontuario, NomedoUsuario, Profissional.

Nome dos campos no Form: CodAgendamentos, txtPront, txtUsuario, txtProf

Olá...., Bom dia

O nome da tabela e do Form serão estes mesmos?
Neste form você ira colocar como fonte de registros a tabela ou a consulta?

Aguardo

Olá...

Segue o código corrigido, ele esta como fonte de registro o nome da tabela.
Se for usar a consulta, então terá apenas que substituir o nome da tabela pelo nome da consulta.
Terá que alterar em todas as linhas do código.

Código:

Private Sub txtProf_AfterUpdate()
   
    'Ativa rotina de tratamento de erro
    On Error GoTo TrataErro

    'declara variável do tipo recordset
    Dim rst As DAO.Recordset
   
    'seta a variável
    Set rst = Me.RecordsetClone
   
    'compara o registro com o recordset
    rst.FindFirst "[Prontuario] ='" & Me!txtPront & "' And [NomedoUsuario] ='" & Me!txtUsuario & "' And [Profissional] ='" & Me!txtProf & "'"
   
        'verifica se não é fim de arquivo
        If Not rst.NoMatch Then
       
            'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "tblAgendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "tblAgendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "tblAgendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "tblAgendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
            Else
                Me.Undo
            End If
        End If
   
    'fecha o recordset
    rst.Close
    'libera memoria
    Set rst = Nothing
   
'Tratamento de erro
Exit_Trataerro:
    Exit Sub

TrataErro:
    'exibe mensagem com o erro ocorrido
    MsgBox "Erro número: " & Err.Number & " - " & Err.Description & " (" & Me.Name & " - " & Me.ActiveControl.Name & " - BeforeUpdate).", vbCritical, "Titulo"
    Resume Next
 
End Sub


Aguardo

Abraços

Olá Celso Roberto!

Isso, o Nome da tabela e do Form serão estes mesmo.

Mas no caso da fonte de registro do Form seria a Consulta, nomeada por; "Cslt_Agendamentos"

Nome da tabela: SistemadeAgendamentos

Nome da Consulta: Cslt_Agendamentos

nome dos Campos da Tabela: Cod_Agendamentos; Prontuario; NomedoUsuario; Profissional

nome dos Campos fo Form: CodAgendamentos; txtPront; txtUsuario; txtProf


Muito obrigado mesmo amigo por compartilhar seus conhecimentos!

Ok vou tentar adaptar aqui o código substituindo o nome da tabela pela consulta.

já retorno!

obrigado!
abraço!

Olá..
Segue com a consulta

Código:

Private Sub txtProf_AfterUpdate()
   
    'Ativa rotina de tratamento de erro
    On Error GoTo TrataErro

    'declara variável do tipo recordset
    Dim rst As DAO.Recordset
   
    'seta a variável
    Set rst = Me.RecordsetClone
   
    'compara o registro com o recordset
    rst.FindFirst "[Prontuario] ='" & Me!txtPront & "' And [NomedoUsuario] ='" & Me!txtUsuario & "' And [Profissional] ='" & Me!txtProf & "'"
   
        'verifica se não é fim de arquivo
        If Not rst.NoMatch Then
       
            'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "Cslt_Agendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "Cslt_Agendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
            Else
                Me.Undo
            End If
        End If
   
    'fecha o recordset
    rst.Close
    'libera memoria
    Set rst = Nothing
   
'Tratamento de erro
Exit_Trataerro:
    Exit Sub

TrataErro:
    'exibe mensagem com o erro ocorrido
    MsgBox "Erro número: " & Err.Number & " - " & Err.Description & " (" & Me.Name & " - " & Me.ActiveControl.Name & " - BeforeUpdate).", vbCritical, "Titulo"
    Resume Next
 
End Sub


Aguardo

Vou postar o banco pra que tu possa dar uma olhada, tá dando um erro, no caso eu consigo agendar o primeiro, daí o segundo agendamentos com dados distintos o sistema retorna Erro.

o Bd foi criado no msAccess 2010.

Sou muito grato pela ajuda amigo!

segue o anexo postado no dropbox

dropbox.com/home?preview=SISGAM.zip

Olá..

Como te disse anteriormente a versão do meu access é 2007 e ele não reconhece as versões superiores.

Sugiro que faça uma cópia e converta em salvar como para uma versão inferior a sua e anexe no em formato Zip.

Sugiro que mantenha a pesquisa direto na tabela, o form pode ter a fonte de registro na consulta sem problemas, mas a pesquisa seria ideal buscar na tabela.

Faça testes e retorne

Aguardo

ok vou fazer isto.

Muito grato!

Olá caro amigo Celso!

Creio que este exemplo que postarei irá rodar no acess 2007, tinha algumas referências habilitadas que não roda no 2007.


Está mais perto que longe, vou postar esse exemplo caso rode no access 2007, poderá me ajudar.

Mas de qualquer forma muito obrigado pela valiosa ajuda, nada nada vou fuçando seu exemplo até acertar.


"aquele que pergunta é tolo por cinco minutos mas aquele que não pergunta permanece tolo para sempre"
Voltar ao Topo

olá....

Não rodou

Tente:
Faça uma cópia deste que anexou
Abra o BD
Vai em salvar como
Opção "Salvar banco de dados em outro formato
Escolha um formato 2007 para baixo

Você precisa que a fonte de registro seja a consulta?
Caso Não, mude o form para a tabela e faça teste com o código também pesquisando na tabela
Caso Sim, e não consiga fazer cópia da bd então manda um print da consulta no modo Design e um print em modo folha de dados

Faça um teste com este outro código

Código:

Private Sub txtProf_AfterUpdate()
            
       Dim rst As Recordset
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblAgendamentos")

        Do While Not rst.EOF
        If rst![Prontuario] = Me.txtPront.Value And rst![NomeUsuario] = Me.txtUsuario.Value And rst![Profissional] = Me.txtProf.Value Then
        'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "tblAgendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomeUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "tblAgendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomeUsuario]", "tblAgendamentos", "[NomeUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "tblAgendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
        
        Exit Do
        Else
        Me.Undo
        'faz o procedimento de incluir ou salvar
        End If
        End If
        rst.MoveNext
        Loop
        rst.Close
    
    End Sub

Aguardo

vou lhe postar os prints, enquanto isso vou mexendo aqui pra desvendar essa situação, no qual o intuito seria evitar que haja agendamento do mesmo paciente para o mesmo médico na mesma data.

Grato sempre!

Olá..
estamos tendo problemas com nomes de campos

Veja no print 4 na linha amarela o
rst![NomeUsuario] Seria rst![NomeDoUsuario]
rst![PROFISSIONAL] Seria rst![Profissional]

Teste: sem alterar nada no código

Código:

Private Sub txtProf_AfterUpdate()
           
      Dim rst As Recordset
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM Cslt_Agendamentos")

        Do While Not rst.EOF
        If rst![Prontuario] = Me.txtPront.Value And rst![NomedoUsuario] = Me.txtUsuario.Value And rst![Profissional] = Me.txtProf.Value Then
        'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "Cslt_Agendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "Cslt_Agendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
       
        Exit Do
        Else
        Me.Undo
        'faz o procedimento de incluir ou salvar
        End If
        End If
        rst.MoveNext
        Loop
        rst.Close
   
    End Sub

E este:

Código:

Private Sub txtProf_AfterUpdate()
   
    'Ativa rotina de tratamento de erro
    On Error GoTo TrataErro

    'declara variável do tipo recordset
    Dim rst As DAO.Recordset
   
    'seta a variável
    Set rst = Me.RecordsetClone
   
    'compara o registro com o recordset
    rst.FindFirst "[Prontuario] ='" & Me!txtPront & "' And [NomedoUsuario] ='" & Me!txtUsuario & "' And [Profissional] ='" & Me!txtProf & "'"
   
        'verifica se não é fim de arquivo
        If Not rst.NoMatch Then
       
            'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "Cslt_Agendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "Cslt_Agendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "Cslt_Agendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
            Else
                Me.Undo
            End If
        End If
   
    'fecha o recordset
    rst.Close
    'libera memoria
    Set rst = Nothing
   
'Tratamento de erro
Exit_Trataerro:
    Exit Sub

TrataErro:
    'exibe mensagem com o erro ocorrido
    MsgBox "Erro número: " & Err.Number & " - " & Err.Description & " (" & Me.Name & " - " & Me.ActiveControl.Name & " - BeforeUpdate).", vbCritical, "Titulo"
    Resume Next
 
End Sub


Teste os dois e retorne com os erros

Aguardo

Dá uma olhada nesses erros aí caro amigo?

tá quase dando certo , fé em Deus e paciência vai chegar.

Obrigado!

Olá...

Desculpe a complicação, mas sem o banco de dados para analizar é muito dificil achar o erro, Mas Vamos até o fim..

Elimine na consulta os critérios dos campos Prontuario e NomedoUsuario

Troque por qualquer um dos códigos abaixo, o resultado será o mesmo

Código:

Private Sub txtProf_AfterUpdate()
           
      Dim rst As Recordset
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl_Agendamentos")

        Do While Not rst.EOF
        If rst![Prontuario] = Me.txtPront.Value And rst![NomedoUsuario] = Me.txtUsuario.Value And rst![Profissional] = Me.txtProf.Value Then
        'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "tbl_Agendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "tbl_Agendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "tbl_Agendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "tbl_Agendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
       
        Exit Do
        Else
        Me.Undo
        'faz o procedimento de incluir ou salvar
        End If
        End If
        rst.MoveNext
        Loop
        rst.Close
   
   
    End Sub


Ou

Código:

Private Sub txtProf_AfterUpdate()
           
      'Ativa rotina de tratamento de erro
    On Error GoTo TrataErro

    'declara variável do tipo recordset
    Dim rst As DAO.Recordset
   
    'seta a variável
    Set rst = Me.RecordsetClone
   
    'compara o registro com o recordset
    rst.FindFirst "[Prontuario] ='" & Me!txtPront & "' And [NomedoUsuario] ='" & Me!txtUsuario & "' And [Profissional] ='" & Me!txtProf & "'"
   
        'verifica se não é fim de arquivo
        If Not rst.NoMatch Then
       
            'avisa
            If MsgBox("Já existe um Agendamento de código" & Space(2) & "" _
            & DLookup("[Cod_Agendamento]", "tbl_Agendamentos", "[Prontuario] = '" & Me!txtPront & "' and [NomedoUsuario] = '" & Me!txtUsuario & "'and [Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Para o Prontuario" & vbCrLf & "" _
            & DLookup("[Prontuario]", "tbl_Agendamentos", "[Prontuario] = '" & Me!txtPront & "'") & vbCrLf & "" _
            & "Em Nome do Usuario" & vbCrLf & "" _
            & DLookup("[NomedoUsuario]", "tbl_Agendamentos", "[NomedoUsuario] = '" & Me!txtUsuario & "'") & vbCrLf & "" _
            & "Para o Profissional de Nome" & vbCrLf & "" _
            & DLookup("[Profissional]", "tbl_Agendamentos", "[Profissional] = '" & Me!txtProf & "'") & vbCrLf & "" _
            & "Deseja Ir para Registro e Conferir dados? ", vbYesNo + vbExclamation + vbDefaultButton2, "Confirmação") = vbYes Then
                'desfaz a digitação
                Me.Undo
                'mostra o registro correspondente
                Me.Bookmark = rst.Bookmark
            Else
                Me.Undo
            End If
        End If
   
    'fecha o recordset
    rst.Close
    'libera memoria
    Set rst = Nothing
   
'Tratamento de erro
Exit_Trataerro:
    Exit Sub

TrataErro:
    'exibe mensagem com o erro ocorrido
    MsgBox "Erro número: " & Err.Number & " - " & Err.Description & " (" & Me.Name & " - " & Me.ActiveControl.Name & " - BeforeUpdate).", vbCritical, "Titulo"
    Resume Next
   
    End Sub


Aguardo

Olá....

Como o 2010 me parece que não permite salvar como formato anterior eu tive uma idéia,
Vá na mensagem em que eu anexei um Bd de Exemplo e baixe ele e descompacte.
Abra ele e exclua as tabelas e consultas e forms anexos.
Click em dados externos e selecione a opção Access.
Vai abrir uma tela No Botão procurar selecione a pasta que esta seu Bd e de um ok
Vai abrir outar tela Importar objetos.
Selecione aba tabelas e marque as tabelas envolvidas
Selecione aba consultas e marque todas envolvidas
Faça a mesma coisa nos forms, relatórios, macros e módulos
De ok
Vai gerar um bd com todos os selecionados
Anexe ele em formato zip

Aguardo

Olá Prezado Celso Bom dia! Tudo bem amigo?

É, realmente sem você poder ver o BD, fica complicado mesmo, bela idéia sua de usar o arquivo que tu postou, pois fiz como orientado, creio que agora vai dar certo, olhando o BD de perto as noções ficam mais claras sobre o problema.

Muito obrigado pela paciência!

segue em anexo Zip o modelo do BD.

O formulário em questão é: SistemadeMarcações
que através da Consulta "Cslt_Agendamentos", cria relacionamentos com 3 Tabelas que são; Cadastro_Cliente, Tbl_Agendamentos e Tbl_VagasMedico, que é a Tabela que lança as vagas e as quantidade da vaga para serem agendadas.

E por fim através da Cstl_Agendamentos, gera um Relatório com os Dados necessários.


"Deus abençoe sua Sabedoria e a boa vontade de ajudar"

Olá...

Desculpe não ter respondido antes, Hoje passei o dia todo fora da empresa.
Estou chegando em casa agora e vou verificar, amanha te retorno

Abraços

Não há do que se desculpar Amigo! sem problemas, a corre-corre da vida é isso mesmo, já está me ajudando muito e sou muito Grato por isso!

Fica na Paz de Deus!

Olá..

Não consegui abrir o bd, mas peguei um not de amigo emprestado com o 2016 e consegui ver seu bd.

Encontrei muitas inconsistência em seu bd, vou fazer um pequeno bd com algumas alterações para eu poder fazer o código rodar.

Agora tenho umas duvidas:

1º- Se Existir um prontuario para o mesmo profissional com a mesma data e horario é para avisar OK

2º- E se existir um prontuario diferente para o mesmo profissional com a mesma data e horario é para avisar ou Não.

Pergunto porque não sei se talvez o profissional pode atender varios prontuarios ao mesmo tempo.

Aguardo resposta

Abraços

Bom dia Amigo!

sim, talvez haja algumas inconscistências neste bd, devido até a pouca experiência na área, mas se por favor puder corrigir e sinaliza-las pra mim quais foram as alterações, agradeço muito pela ajuda.






-2º- E se existir um prontuario diferente para o mesmo profissional com a mesma data e horário é para avisar ou Não.
 
Não.

Para este caso adaptei um código para contar vagas e quando chegar a 0 avisar. o profissional poderá agendar enquanto haver vagas, vários Prontuários diferentes na mesma Data e Horário. Só não pode o mesmo paciente agendar o mesmo Profissional e Data e horário igual duas vezes. A dificuldade minha é um Vb pra informar ao usuário final sobre essa duplicidade.

ex.: São três recepcionistas, elas estão agendando o mesmo paciente para o mesmo profissional data e horário,  várias vezes. se o sistema avisar a duplicidade elas não irão agendar duas vezes o mesmo prontuario.

Muito Obrigado!

Aguardo Novidades...

Olá..

OK, entendi

já consegui fazer ele dizer que já existe o agendamento, só falta fazer ele buscar o agendamento original para editar.

se esta parte não for necessário me avise que te envio as alterações

Aguardo

Abraços

Salve Salve Amigo !!!

Boa tarde Celso!

Não é necessário buscar o agendamento original para editar, somente informar ao usuário Final que há um agendamento igual, daquele paciente para o mesmo profissional na Data e horário que ele está tentando agendar.

É só o caso de impedir que o UserFinal Faça o mesmo agendamento para o mesmo profissional duas vezes, não é necessário que ele edite, somente para sinaliza-lo.


Obrigado!

Forte Abraço!

Olá...

Deixei ele buscando o agendamento original para se caso for precisar editar, caso não queira editar clicar em não na caixa de dialogo.

Vamos as explicações, dizer tudo que foi alterado fica um pouco difícil devido a quantidade de alterações

Alteração das tabelas e os relacionamentos:
Na tabela do cliente não adicionei todos os campos como estava na original, veja quais campos serão necessários e adicione levando em conta que deve estar nela somente oque diz respeito ao cliente.
informações adicionais como médico que já passou, doenças existentes e outras deve existir uma tabela de Histórico do cliente, ai você busca informação criando uma consulta.
Informações que já existe em outras tabelas não adicionar e sim da mesma forma criar consultas.

Na tabela Agendamento Agir da mesma forma, eu acredito que conforme eu deixei estaria correto, mas se faltar alguma informação verificar corretamente para não deixar a consulta qryAgendamentos de forma inconsistente, se isto acontecer o formulário não vai agir corretamente

No formulário fiz pequenas alterações, apenas a busca do prontuario e profissional esta como combo,
então voce pode digitar ou pesquisar expandindo a combo

Mais alguns detalhes você verá comparando com o seu original
Faça a verificação e me retorne

Abraços

Olá Boa Noite!

Ok Amigo, muito obrigado mesmo!

Vou mexer agora aqui, mãos a obra, tentar adaptar aqui, logo postarei novidades. há algumas alterações a fazer, dei uma olhada no exemplo enviado, vou seguir suas orientações.

Grato...!

Olá..

Apenas para titulo de informação, não adicionar nomes em tabelas e forms com espaços e com caracteres e também não usar nomes reservado ao access como Nome,Data,Valor e outros, use
txtData,DtData,txtValor, também não use nomes repetidos para não dificultar quando precisar vincular um ao outro em tabelas.

Não mexi nos relalatórios, acredito que terá que verificar alguns erros

Da mesma forma o Fórum agradece o seu retorno

Abraços e bom trabalho

Hum...

Entendi Amigo, então devo fazer várias alterações, quando a esses nomes na tabela que são reservados ao Access, não sabia mesmo.

Vai ser trabalhoso, mas o certo é certo.

Muito obrigado mesmo, Deus vos abençoe grandiosamente!

Olá..
Não sei como esta tamanho do seu Bd Original, não seria melhor seguir com os complementos no exemplo que te enviei?

ou importe ele para seu db original.

Abraços