Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Não Permitir Gravar Cpf duplicado

Discussões sobre a integração do Excel com o Banco de Dados Access

Moderador: joseA

CROVADOR
Manda bem
Manda bem
Mensagens: 106
Registrado em: Ter Mar 13, 2018 11:15 am

Re: Não Permitir Gravar Cpf duplicado

Mensagem 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
Anexos
KROVTECH ORÇAMENTO.rar
(208.48 KiB) Baixado 211 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


CROVADOR
Manda bem
Manda bem
Mensagens: 106
Registrado em: Ter Mar 13, 2018 11:15 am

Re: Não Permitir Gravar Cpf duplicado

Mensagem 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


CROVADOR
Manda bem
Manda bem
Mensagens: 106
Registrado em: Ter Mar 13, 2018 11:15 am

Re: Não Permitir Gravar Cpf duplicado

Mensagem 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


CROVADOR
Manda bem
Manda bem
Mensagens: 106
Registrado em: Ter Mar 13, 2018 11:15 am

Re: Não Permitir Gravar Cpf duplicado

Mensagem 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


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


CROVADOR
Manda bem
Manda bem
Mensagens: 106
Registrado em: Ter Mar 13, 2018 11:15 am

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

Mensagem 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


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder