Página 2 de 2

Re: Não Permitir Gravar Cpf duplicado

Enviado: Ter Jan 19, 2021 1:03 pm
por CROVADOR
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

Re: Não Permitir Gravar Cpf duplicado

Enviado: Ter Jan 19, 2021 9:55 pm
por CROVADOR
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

Re: Não Permitir Gravar Cpf duplicado

Enviado: Qui Jan 21, 2021 2:10 am
por CROVADOR
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

Re: Não Permitir Gravar Cpf duplicado

Enviado: Ter Fev 09, 2021 7:32 pm
por CROVADOR
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

Re: Não Permitir Gravar Cpf duplicado [Resolvido]

Enviado: Ter Fev 09, 2021 7:46 pm
por CROVADOR
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