Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Não Permitir Gravar Cpf duplicado
Moderador: joseA
Não Permitir Gravar Cpf duplicado
Olá amigos, eu novamente pedindo socorro, kkk ...
tenho o seguinte código abaixo e não que que grave o mesmo cpf que já existe no banco de dados.
Alguma idéia pessoal?
Private Sub btnGravar_Click()
If Me.txtNome = Empty Then
MsgBox "Digite O Nome Do Cliente.", vbExclamation, "Atenção"
Me.txtNome.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDetum.AddNew
Else
rsOrçGradum.Close
SqlOrçGradum = "DELETE FROM tbOrçamento_Grade1 WHERE Nro_Orçamento = " & NroOrçum 'Apaga os registros antigos
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGradum = "SELECT * FROM tbOrçamento_Grade1"
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDetum(1) = Date
rsOrçDetum(2) = Me.txtNome
rsOrçDetum(3) = Me.txtObservaçoes
rsOrçDetum(4) = Me.txtTelefone
rsOrçDetum(5) = Me.txt_contato
rsOrçDetum(6) = Me.txt_email
rsOrçDetum(7) = Me.txt_endereço
rsOrçDetum(8) = Me.txt_cnpj_cpf
rsOrçDetum(9) = Me.txt_ie
rsOrçDetum(10) = Me.TXT_NUMERO
rsOrçDetum(11) = Me.txt_bairro
rsOrçDetum(12) = Me.txt_cep
rsOrçDetum(13) = Me.txt_cidade
rsOrçDetum(14) = Me.txt_uf
rsOrçDetum.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGradum.AddNew
rsOrçGradum(0) = NroOrçum
rsOrçGradum(1) = .ListItems(i)
rsOrçGradum(2) = .ListItems(i).ListSubItems(1)
rsOrçGradum.Update
End With
Next i
If Inc = True Then
rsNroum.AddNew
rsNroum(0) = NroOrçum
rsNroum.Update
End If
LimpaControles
rsNroum.MoveLast
NroOrçum = rsNroum(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrçum
iCancel = 0
MsgBox "Registro Salvo Com Sucesso.", vbInformation, "Clientes"
Me.btnLer.Enabled = True
End Sub
tenho o seguinte código abaixo e não que que grave o mesmo cpf que já existe no banco de dados.
Alguma idéia pessoal?
Private Sub btnGravar_Click()
If Me.txtNome = Empty Then
MsgBox "Digite O Nome Do Cliente.", vbExclamation, "Atenção"
Me.txtNome.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDetum.AddNew
Else
rsOrçGradum.Close
SqlOrçGradum = "DELETE FROM tbOrçamento_Grade1 WHERE Nro_Orçamento = " & NroOrçum 'Apaga os registros antigos
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGradum = "SELECT * FROM tbOrçamento_Grade1"
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDetum(1) = Date
rsOrçDetum(2) = Me.txtNome
rsOrçDetum(3) = Me.txtObservaçoes
rsOrçDetum(4) = Me.txtTelefone
rsOrçDetum(5) = Me.txt_contato
rsOrçDetum(6) = Me.txt_email
rsOrçDetum(7) = Me.txt_endereço
rsOrçDetum(8) = Me.txt_cnpj_cpf
rsOrçDetum(9) = Me.txt_ie
rsOrçDetum(10) = Me.TXT_NUMERO
rsOrçDetum(11) = Me.txt_bairro
rsOrçDetum(12) = Me.txt_cep
rsOrçDetum(13) = Me.txt_cidade
rsOrçDetum(14) = Me.txt_uf
rsOrçDetum.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGradum.AddNew
rsOrçGradum(0) = NroOrçum
rsOrçGradum(1) = .ListItems(i)
rsOrçGradum(2) = .ListItems(i).ListSubItems(1)
rsOrçGradum.Update
End With
Next i
If Inc = True Then
rsNroum.AddNew
rsNroum(0) = NroOrçum
rsNroum.Update
End If
LimpaControles
rsNroum.MoveLast
NroOrçum = rsNroum(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrçum
iCancel = 0
MsgBox "Registro Salvo Com Sucesso.", vbInformation, "Clientes"
Me.btnLer.Enabled = True
End Sub
Re: Não Permitir Gravar Cpf duplicado
Crovador,
O Access tem essa funcionalidade de fábrica. O campo em questão pode ser marcado como Indexado = Sim (Não Duplicado).
Isso resolve o problema.
O Access tem essa funcionalidade de fábrica. O campo em questão pode ser marcado como Indexado = Sim (Não Duplicado).
Isso resolve o problema.
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Não Permitir Gravar Cpf duplicado
Em adicional, verifique se a sugestão do Paulinho (PMPOKER) no tópico https://www.tomasvasquez.com.br/forum/v ... =22&t=6427, não lhe auxilia
Re: Não Permitir Gravar Cpf duplicado
Fiz o procedimento mas não deu certo, ele apresenta erro!
erro em tempo de execução 2147217887 (80040e21)
as alterações solicitadas para a tabela não foram satisfatórias já que criaram valores duplicados....
erro em tempo de execução 2147217887 (80040e21)
as alterações solicitadas para a tabela não foram satisfatórias já que criaram valores duplicados....
Re: Não Permitir Gravar Cpf duplicado
Crovador,
Mas é exatamente isso que precisa acontecer. Leia a mensagem. Capture o erro e apresente o alerta.
Fazer direto pelo Access não é só mais rápido como garantido.
Mas é exatamente isso que precisa acontecer. Leia a mensagem. Capture o erro e apresente o alerta.
Fazer direto pelo Access não é só mais rápido como garantido.
Re: Não Permitir Gravar Cpf duplicado
Bom dia amigo, não consegui fazer, vou mandar aqui o anexo, se poder dar uma olha sem te atrapalhar ficaria grato, e mais uma vez obrigado pela sua atenção....
está em cadastro de clientes...
está em cadastro de clientes...
- Anexos
-
- Nova pasta.rar
- (140.84 KiB) Baixado 269 vezes
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Não Permitir Gravar Cpf duplicado
Creio eu que a tabela em questão seja a de nome ==> "tbOrç_Detalhe1"
Como disse o Webmaster, sua tabela já está "configurada" para não aceitar cpf/cnpj duplicado; e o access controla essa situação de maneira eficiente; assim ao tentar incluir um registro de cliente com esse campo duplicado, irá gerar um erro ao salvar o registro.
Se desejar utilizar a proposta do outro tópico, primeiro e preciso definir em que momento essa comparação deva ser efetuada.
Como disse o Webmaster, sua tabela já está "configurada" para não aceitar cpf/cnpj duplicado; e o access controla essa situação de maneira eficiente; assim ao tentar incluir um registro de cliente com esse campo duplicado, irá gerar um erro ao salvar o registro.
Se desejar utilizar a proposta do outro tópico, primeiro e preciso definir em que momento essa comparação deva ser efetuada.
Re: Não Permitir Gravar Cpf duplicado
Isso mesmo Reinaldo, eu tentei fazer igual ao tópico recomendado mas não consegui, eu queria que ao gravar o cliente se já existir no banco ele exibia uma mensagem e não deixasse realizar a gravação.
se poder me auxiliar para fazer este código eu ficaria grato.
mais uma vez muito obrigado pela sua atenção, este fórum todos são shows, que Deus abençoe...
aguardo guri...
se poder me auxiliar para fazer este código eu ficaria grato.
mais uma vez muito obrigado pela sua atenção, este fórum todos são shows, que Deus abençoe...
aguardo guri...
Re: Não Permitir Gravar Cpf duplicado
Amigos tentei usar este código para evitar cadastrar mesmo cpf, mas não tive exito...
Socorro!!!! kkkk
Private Sub btnGravar_Click()
'verificar se o registro já existe na tabela
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ThisWorkbook.Path & "\Banco.mdb"
rstBanco.Open "SELECT * Valor FROM tbOrçamento_Grade1 WHERE cnpj_cpf=" & Me.txt_cnpj_cpf.Text, cn, adOpenKeyset, adLockOptimistic, adCmdText
'Testa se o Recordset possui algum retorno, ou seja, se existe o registro. Caso não exista, segue na rotina de inclusão. Caso exista, exibe uma mensagem.
If IsNull(rsOrçGradum.RecordCount) Or rsOrçGradum.RecordCount < 1 Then 'Se o Recordset é nulo ou não existe o registro:
With rsOrçGradum
.AddNew
.Fields("cnpj_cpf") = Me.txt_cnpj_cpf.Text
rsOrçGradum.Update
End With
Else
MsgBox "Código já cadastrado!"
Exit Sub
End If
If Me.txtNome = Empty Then
MsgBox "Digite O Nome Do Cliente.", vbExclamation, "Atenção"
Me.txtNome.SetFocus
Exit Sub
End If
If Me.txt_cnpj_cpf = Empty Then
MsgBox "Digite Cnpj/Cpf.", vbExclamation, "Atenção"
Me.txt_cnpj_cpf.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDetum.AddNew
Else
rsOrçGradum.Close
SqlOrçGradum = "DELETE FROM tbOrçamento_Grade1 WHERE Nro_Orçamento = " & NroOrçum 'Apaga os registros antigos
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGradum = "SELECT * FROM tbOrçamento_Grade1"
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDetum(1) = Date
rsOrçDetum(2) = Me.txtNome
rsOrçDetum(3) = Me.txtObservaçoes
rsOrçDetum(4) = Me.txtTelefone
rsOrçDetum(5) = Me.txt_contato
rsOrçDetum(6) = Me.txt_email
rsOrçDetum(7) = Me.txt_endereço
rsOrçDetum(8) = Me.txt_cnpj_cpf
rsOrçDetum(9) = Me.txt_ie
rsOrçDetum(10) = Me.TXT_NUMERO
rsOrçDetum(11) = Me.txt_bairro
rsOrçDetum(12) = Me.txt_cep
rsOrçDetum(13) = Me.txt_cidade
rsOrçDetum(14) = Me.txt_uf
rsOrçDetum.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGradum.AddNew
rsOrçGradum(0) = NroOrçum
rsOrçGradum(1) = .ListItems(i)
rsOrçGradum(2) = .ListItems(i).ListSubItems(1)
rsOrçGradum.Update
End With
Next i
If Inc = True Then
rsNroum.AddNew
rsNroum(0) = NroOrçum
rsNroum.Update
End If
LimpaControles
rsNroum.MoveLast
NroOrçum = rsNroum(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrçum
iCancel = 0
MsgBox "Registro Salvo Com Sucesso.", vbInformation, "Clientes"
Me.btnLer.Enabled = True
End Sub
Socorro!!!! kkkk
Private Sub btnGravar_Click()
'verificar se o registro já existe na tabela
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ThisWorkbook.Path & "\Banco.mdb"
rstBanco.Open "SELECT * Valor FROM tbOrçamento_Grade1 WHERE cnpj_cpf=" & Me.txt_cnpj_cpf.Text, cn, adOpenKeyset, adLockOptimistic, adCmdText
'Testa se o Recordset possui algum retorno, ou seja, se existe o registro. Caso não exista, segue na rotina de inclusão. Caso exista, exibe uma mensagem.
If IsNull(rsOrçGradum.RecordCount) Or rsOrçGradum.RecordCount < 1 Then 'Se o Recordset é nulo ou não existe o registro:
With rsOrçGradum
.AddNew
.Fields("cnpj_cpf") = Me.txt_cnpj_cpf.Text
rsOrçGradum.Update
End With
Else
MsgBox "Código já cadastrado!"
Exit Sub
End If
If Me.txtNome = Empty Then
MsgBox "Digite O Nome Do Cliente.", vbExclamation, "Atenção"
Me.txtNome.SetFocus
Exit Sub
End If
If Me.txt_cnpj_cpf = Empty Then
MsgBox "Digite Cnpj/Cpf.", vbExclamation, "Atenção"
Me.txt_cnpj_cpf.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDetum.AddNew
Else
rsOrçGradum.Close
SqlOrçGradum = "DELETE FROM tbOrçamento_Grade1 WHERE Nro_Orçamento = " & NroOrçum 'Apaga os registros antigos
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGradum = "SELECT * FROM tbOrçamento_Grade1"
rsOrçGradum.Open SqlOrçGradum, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDetum(1) = Date
rsOrçDetum(2) = Me.txtNome
rsOrçDetum(3) = Me.txtObservaçoes
rsOrçDetum(4) = Me.txtTelefone
rsOrçDetum(5) = Me.txt_contato
rsOrçDetum(6) = Me.txt_email
rsOrçDetum(7) = Me.txt_endereço
rsOrçDetum(8) = Me.txt_cnpj_cpf
rsOrçDetum(9) = Me.txt_ie
rsOrçDetum(10) = Me.TXT_NUMERO
rsOrçDetum(11) = Me.txt_bairro
rsOrçDetum(12) = Me.txt_cep
rsOrçDetum(13) = Me.txt_cidade
rsOrçDetum(14) = Me.txt_uf
rsOrçDetum.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGradum.AddNew
rsOrçGradum(0) = NroOrçum
rsOrçGradum(1) = .ListItems(i)
rsOrçGradum(2) = .ListItems(i).ListSubItems(1)
rsOrçGradum.Update
End With
Next i
If Inc = True Then
rsNroum.AddNew
rsNroum(0) = NroOrçum
rsNroum.Update
End If
LimpaControles
rsNroum.MoveLast
NroOrçum = rsNroum(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrçum
iCancel = 0
MsgBox "Registro Salvo Com Sucesso.", vbInformation, "Clientes"
Me.btnLer.Enabled = True
End Sub
Editado pela última vez por CROVADOR em Ter Jan 19, 2021 1:07 pm, em um total de 1 vez.
Re: Não Permitir Gravar Cpf duplicado
Fazer uma consulta e verificar se o RecordSet está vazio é uma opção, pq não deu certo? Qual erro?
Não vi a parte que faz o SELECT pra gerar o RecordSet antes de fazer o teste nele, tem que ser a primeira coisa.
Não vi a parte que faz o SELECT pra gerar o RecordSet antes de fazer o teste nele, tem que ser a primeira coisa.