Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Não Permitir Gravar Cpf duplicado
Moderador: joseA
Re: Não Permitir Gravar Cpf duplicado
Olá amigo, primeiramente obrigado pela atenção, eu sou um pouco leigo será que poderia me auxiliar e descrever essa parte que faltou? tentei esse aqui mas não deu certo...
vou anexar para vc ver, está em cadastro de clientes.
Deus abençoe...
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
vou anexar para vc ver, está em cadastro de clientes.
Deus abençoe...
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
- Anexos
-
- KROVTECH ORÇAMENTO.rar
- (208.48 KiB) Baixado 225 vezes
Re: Não Permitir Gravar Cpf duplicado
Boa noite amigos, eu tentei este código também mas não tive exito...
Estou na luta vamos lá...
erro em tempo de execução 424
objeto é obrigatório
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
Dados.Open "SELECT * FROM tbOrç_Detalhe1", cnpj_cpf, 3, 3
Do Until Dados.EOF
If Dados(1) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
cn.Close
Exit Sub
End If
Dados.MoveNext
Loop
cn.Close
End Sub
Estou na luta vamos lá...
erro em tempo de execução 424
objeto é obrigatório
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
Dados.Open "SELECT * FROM tbOrç_Detalhe1", cnpj_cpf, 3, 3
Do Until Dados.EOF
If Dados(1) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
cn.Close
Exit Sub
End If
Dados.MoveNext
Loop
cn.Close
End Sub
Re: Não Permitir Gravar Cpf duplicado
Caros amigos, tentei esse código mas esta dando erro..
onde estou errando...alguém me ajude
erro em tempo de execução '3705'
operação não permitida quando o objeto está aberto.
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
rsOrçDetum.Open "SELECT * FROM tbOrç_Detalhe1", Db, 15, 15
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
cn.Close
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
cn.Close
End Sub
onde estou errando...alguém me ajude
erro em tempo de execução '3705'
operação não permitida quando o objeto está aberto.
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
rsOrçDetum.Open "SELECT * FROM tbOrç_Detalhe1", Db, 15, 15
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
cn.Close
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
cn.Close
End Sub
Re: Não Permitir Gravar Cpf duplicado
Boa noite amigos, estou com este código, ele até funciona na primeira vez que digito o cpf repetido, mas quando coloco outro cpf ele vai normal, porém volto ao campo e apago o que não é repetido e digito novamente o repetido e ele não traz a mensagem que ja existe. alguém poderia me ajudar?
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
ComandoSQL = "SELECT * FROM tbOrç_Detalhe1"
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este Cnpj/Cpf " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
'rsOrçDetum.Close
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
'rsOrçDetum.Close
End Sub
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
ComandoSQL = "SELECT * FROM tbOrç_Detalhe1"
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este Cnpj/Cpf " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
'rsOrçDetum.Close
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
'rsOrçDetum.Close
End Sub
Re: Não Permitir Gravar Cpf duplicado [Resolvido]
Private Sub txt_cnpj_cpf_afterupdate()
'On Error Resume Next
Dim ComandoSQL As String
SqlOrçDetum = "SELECT * FROM tbOrç_Detalhe1" 'Listagem de Orçamentos
Set rsOrçDetum = New ADODB.Recordset
rsOrçDetum.Open SqlOrçDetum, cn, adOpenKeyset, adLockOptimistic
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este Cnpj/Cpf " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
End Sub
'On Error Resume Next
Dim ComandoSQL As String
SqlOrçDetum = "SELECT * FROM tbOrç_Detalhe1" 'Listagem de Orçamentos
Set rsOrçDetum = New ADODB.Recordset
rsOrçDetum.Open SqlOrçDetum, cn, adOpenKeyset, adLockOptimistic
Do Until rsOrçDetum.EOF
If rsOrçDetum(8) = "" & Me.txt_cnpj_cpf.Text Then
MsgBox "Este Cnpj/Cpf " & Me.txt_cnpj_cpf.Text & " É Existente!", vbInformation, "Aviso!"
txt_cnpj_cpf = Empty
Exit Sub
End If
rsOrçDetum.MoveNext
Loop
End Sub