Notifications
Clear all

Evitar Cadastro de duplicidade no Banco Acess com Formulário

11 Posts
2 Usuários
0 Reactions
2,620 Visualizações
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Boa noite Expertises,
Estou criando um formulário para cadastrar as notas fiscais de devolução num Bd access.
Para isso funcione não pode ter nota fiscal repetidas na tabela.
Até o momento não consegui fazer ao clicar no botão gravar que ele faça essa verificação.
Quando clico no botão salvar ele dá erro
"erro em tempo de execução '424':
Objeto é obrigatório"
Quando clico em Depurar
o campo
"Set consulta = banco.OpenRecordset(ComandoSQL)" está marcado e quando passamos o mouse ele aparece"consulta=vazio"

Private Sub Btn_Salvar_Click()
    Dim TipoD As String
    
    TipoD = Cmb_Tipo
    rs.AddNew

    rs.Fields("Mes") = Me.Txt_Mes_Ocorrencia.Text
    rs.Fields("Ano") = Me.Txt_Ano_Ocorrencia.Text
    rs.Fields("Nota_Fiscal") = Me.Txt_Nota_Fiscal.Text
    
      If TipoD = "D" Then
       rs.Fields("Tipo_D") = Me.Cmb_Tipo.Text
    Else
       rs.Fields("Tipo_R") = Me.Cmb_Tipo.Text
    End If
    
    
    'Rs.Fields("Tipo") = Me.Cmb_Tipo.Text
    rs.Fields("Data_Ocorrencia") = Me.Txt_Data_Ocorrencia
    rs.Fields("Data_Faturamento") = Me.Txt_Data_Faturamento.Text
    rs.Fields("Prazo_Entrega") = Me.Txt_N_Dias.Text
    rs.Fields("Entregador") = Me.Cmb_Entregador.Text
    rs.Fields("Codigo_Cliente") = Me.Txt_Codigo_Clie.Text
    rs.Fields("Razao_Social") = Me.Txt_Razao_Social.Text
    rs.Fields("Cidade") = Me.Txt_Cidade.Text
    rs.Fields("Condicao_Pgto") = Me.Txt_Condicao_Pgto.Text
    rs.Fields("Valor_NF") = Me.Txt_Valor_NF.Text
    rs.Fields("Peso_NF") = Me.Txt_Peso.Text
    rs.Fields("Mesa") = Me.Txt_Mesa.Text
    rs.Fields("Supervisor") = Me.Txt_Supervisor.Text
    rs.Fields("Vdd") = Me.Txt_Vdd.Value
    rs.Fields("Vendedor") = Me.Txt_Vendedor.Text
    rs.Fields("Setor_Responsavel") = Me.Cmb_Setor_Responsavel.Text
    rs.Fields("Motivo_Devolucao") = Me.Cmb_Motivo.Text
    rs.Fields("Observacoes_Finan") = Me.Txt_Observacao.Text
    
Dim ComandoSQL As String

ComandoSQL = "select * from Cadastro_Devolucao where nota_Fiscal = '" & Txt_Nota_Fiscal.Text & "'"

Call conecta
Set consulta = banco.OpenRecordset(ComandoSQL)

While Not consulta.EOF

If consulta = Txt_Nota_Fiscal.Text Then
MsgBox "Nota já foi cadastrada. Verifique! ", 64, "ATENÇÃO":
End If

Call desconecta: Exit Sub

consulta.MoveNext
Wend

    MsgBox "Cadastro da Devolução Realizado com Sucesso", vbInformation, "Sistema Devolução"
    Call LimparDados    

End Sub

Minha conexão está assim

Public MiConexao As New ADODB.Connection
Public rs As New ADODB.Recordset

Sub conecta()

    Set MiConexao = New ADODB.Connection
        With MiConexao
            .Provider = "microsoft.ACE.OLEDB.15.0"
            .ConnectionString = "Data Source=" & ThisWorkbook.Path & "BD_DEVOLUCAO.accdb"
            .Open
        End With
            
End Sub

Sub desconecta()

    Set rs = Nothing
    Set MiConexao = Nothing

End Sub
 
Postado : 02/06/2018 5:10 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

jeffsj,

Boa noite!

Sem ver seu arquivo para poder rodar e depurar fica complicado falar alguma coisa. Até porque nem sempre o depurador para exatamente na linha que tem problema.

No pequeno exemplo que fiz há bastante tempo atrás, você tem como estudar todo o tipo de conexão com um Banco de Dados em Acces, inclusive com as operações básicas (consulta, alteração, inserção e exclusão de dados).

Veja se isso pode te ajudar.

 
Postado : 02/06/2018 5:50 pm
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Boa noite Wagner,

Não consigo anexar o meu arquivo ele diz que é muito grande, sendo que o arquivo está com 77kb.

Posso colocar um link do google drive aqui?

Abs,

 
Postado : 02/06/2018 7:12 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

jeffsj,

Bom dia!

Você estudou o arquivo que lhe enviei? Não adiantou de nada?

Quanto a anexar seus arquivos, deixe-o apenas com umas cinco linhas (tanto Excel quanto o Access), compacte com .ZIP e anexe-os aqui. Se não for possível, pode colocar num site de compartilhamento de arquivos sim. Todavia, só posso abrir nesses site, aqui em casa. No trabalho é bloqueado.

 
Postado : 03/06/2018 6:57 am
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Bom dia Wagner,
Estudei sim, tanto que estava com problemas em carregar meu listview e foi vendo seu arquivo que consegui descobri o meu erro.
Estou usando o conexão com ADO, e estava tentando fazer a carregar o listview de outra forma.
Mas tentei de tudo para impedir o cadastro duplicado e não consegui.
Se puder me ajudar, neste momento só falta esse ponto. Neste momento.

https://drive.google.com/open?id=1PT_1o0yMHehbN_zf2ytjUd7-hN_YsyPp

Abraços

 
Postado : 03/06/2018 9:26 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Não consegui baixar seu arquivo.

 
Postado : 03/06/2018 9:39 am
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Vamos Tentar novamente.

https://drive.google.com/file/d/1PT_1o0yMHehbN_zf2ytjUd7-hN_YsyPp/view?usp=sharing

 
Postado : 03/06/2018 10:16 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Nada. Está dando esse tipo de erro (tela abaixo). Poste em outro site de compartilhamento de arquivo.

 
Postado : 03/06/2018 12:08 pm
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Esse é do OneDrive do Outlook.
Pergunta besta, mas você clicou em "fazer dowload" no Google Drive?
https://1drv.ms/u/s!Amsdc_4XRsHoml7zI4QkJqQoFzvI

Abraços,

 
Postado : 03/06/2018 12:28 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Cara,

Sim. Eu cliquei em baixar. Todavia, o que baixou aqui foram os arquivos que eu havia lhe mandado e não os seus arquivos.

Dessa vez, (ufa!) deu certo. Baixei seus arquivos. Todavia, ele não funciona aqui. Qual é a versão do Excel que você está usando? Eu uso a versão 2007.

Todavia, creio que não seja nem preciso eu rodar o seu programa pois você disse que a única coisa que está faltando é você evitar que o cadastro da NF não seja duplicado. Para isso, basta você verificar, antes de gravar no BD, se a NF existe. Veja, naquele meu arquivo enviado, na parte de inserir um novo número de telefone, que eu faço essa verificação (no caso pela Matrícula). Isso já está devidamente tratado lá no exemplo (código abaixo). DETALHE: Veja, que no BD o campo Matrícula não admite gravação duplicada. Ele está configurado como "Sim (Duplicação não autorizada)" no campo Indexado da guia geral da folha no modo Design.

Private Sub Btn_Inserir_Click()

    ' Cria variável para armazenar comandos SQL
    Dim ComandoSQL As String
    Dim consulta2 As Recordset
    
    'Se o campo matrícula NÃO estiver em branco...
    If Txt_Matricula.Text <> "" Then
        'Armazena 3 linhas de comando SQL
        ComandoSQL = "select * from Funcionarios"
        ComandoSQL = ComandoSQL & " Inner Join Ambientes on Funcionarios.CodAmbiente = Ambientes.CodAmbiente"
        'ComandoSQL = ComandoSQL & " where Matrícula like '" & Txt_Matricula.Text & "'"
        
        'Cgama a rotina que faz a conexão com o BD
        Call Conecta
        
        'Atribui a variável de Objeto de BD a execução dos comandos SQL
        Set consulta = banco.OpenRecordset(ComandoSQL)
        
        
       'Enquanto consulta (variável objeto do BD)...
       With consulta
            'Abre o Recordset do BD para inserção
            .AddNew
            
            'Armazena em cada um dos campos do BD (tabela Funcionarios) os valores constantes nas caixas de texto e combo do formulário
            .Fields("Matrícula") = Txt_Matricula.Text
            .Fields("Nome") = Txt_Nome.Text
            .Fields("Ramal") = Txt_Telefone.Text
            .Fields("Funcionarios.CodAmbiente") = Cmb_Codigo.Value
            
            'Se houver erro de acesso aos dados (matrícula já cadastrada), desvia para o rótulo Sai
            On Error GoTo Sai:
            
            'Efetiva a atualização do BD
            .Update
            
        End With
        
        'Fecha o Recorset e a conexão com o BD
        consulta.Close
        banco.Close
        
        'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
        Call Desconecta
        
        'Exibe mensagem de sucesso na inclusão do registro
        MsgBox "Dados Inseridos com Sucesso!", vbDefaultButton1, "INSERÇÃO"
        
'        'Limpa todos os campos para permitir novas inserções
'        Txt_Matricula.Text = ""
'        Txt_Nome.Text = ""
'        Txt_Telefone.Text = ""
'        Cmb_Codigo.Value = ""
'        Lbl_Local.Caption = ""
'
'        'Devolve o cursor para o campo Matrícula
'        Txt_Matricula.SetFocus
        Call Conecta
        Frm_Consulta.Cmb_Nome.Clear
        Set consulta2 = banco.OpenRecordset("select Nome from Funcionarios order by Nome;")
        

        'Laço para preencher o combo nome na inicialização do form, enquanto _
        não chegar o final do arquivo (Tabela Funcionarios)
        Do Until consulta2.EOF
            
            'Adiciona o valor atual da consulta ao combo
            Frm_Consulta.Cmb_Nome.AddItem consulta2![Nome]
            
            'Move o ponteiro dentro do BD para o próximo registro
            consulta2.MoveNext
        Loop
        
        Set consulta2 = Nothing
        
        Call Desconecta
        
        
        
        Unload Me
        Exit Sub
    Else 'Se campo Matrícula estiver em Branco...
        'Exibe mensagem ao usuário para que aceite matrícula automática
        MsgBox "O Campo Matrícula não pode ficar em branco e nem deve conter valores duplicados. Caso não haja matrícula, basta aceitar a matrícula automática.", vbCritical, "INSERÇÃO"
        
        'Devolve o cursor para o campo Matrícula
        Txt_Matricula.SetFocus
        
        Exit Sub
    End If
    
Sai: 'Se houver erro de acesso aos dados (Matrícula já cadastrada), o processamento é desviado para cá
    If Err.Number = 3022 Then
        'Exibe mensagem ao usuário que está tentando inserir uma matrícula já cadastrada
        MsgBox "Esta matrícula já está cadastrada!", vbCritical, "INSERÇÂO"
        
        'Limpa todos os campos para permitir novas inserções
        Txt_Matricula.Text = ""
        Txt_Nome.Text = ""
        Txt_Telefone.Text = ""
        Cmb_Codigo.Value = ""
        Lbl_Local.Caption = ""
        
        'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
        Call Desconecta
        
        'Abandona a subrotina
        Exit Sub
    Else 'Qualquer outro tipo de Erro
        
        'Limpa todos os campos para permitir novas inserções
        MsgBox "Ocorreu o erro De número " & Err.Number & " - " & Err.Description & ". Contate com o Desenvolvedor e informe essa ocorrência.", vbCritical, "INSERÇÃO"
        
        'Limpa todos os campos para permitir novas inserções
        Txt_Matricula.Text = ""
        Txt_Nome.Text = ""
        Txt_Telefone.Text = ""
        Cmb_Codigo.Value = ""
        Lbl_Local.Caption = ""
        
        'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
        Call Desconecta
        
        'Abandona a subrotina
        Exit Sub
    End If
End Sub
 
Postado : 03/06/2018 1:45 pm
(@jeffsj)
Posts: 0
New Member
Topic starter
 

Boa noite Wagner,
Estou usando a versão 2013, estranho você não conseguir fazer funcionar.
Fiz o procedimento no BD conforme sua orientação, ficou certinho. Porém quando eu coloco o "ON Error GOTO sai", Se a nota fiscal está duplicada a única solução que consegui fazer foi fechar o form, não ficou elegante porém vai funcionar por enquanto.
O problema agora é que quando ele faz o insert no Banco ele não termina a ação, ele dá um erro de "tipo incompatível" outra parte do código.
Quando eu tiro o "On error" ele cadastra e não da esse erro.
Abaixo mostro como ficou o meu código.
Se puder me dar mais essa luz.

Private Sub Btn_Salvar_Click()
    
     If Me.Txt_Data_Ocorrencia.Text <> "" Then
   
    'Abre o Recordset do BD para inserção
    Rs.AddNew

    'Se houver erro de acesso aos dados (Nota Fiscal Já Cadastrada), desvia para o rótulo Sai
    On Error GoTo sai:

    'Armazena em cada um dos campos do BD (tabela cadastro_Devolucao) os valores constantes nas caixas de texto e combo do formulário
    Rs.Fields("Mes") = Me.Txt_Mes_Ocorrencia.Text
    Rs.Fields("Ano") = Me.Txt_Ano_Ocorrencia.Value
    Rs.Fields("Nota_Fiscal") = Me.Txt_Nota_Fiscal.Text
    Rs.Fields("Data_Ocorrencia") = Me.Txt_Data_Ocorrencia
    Rs.Fields("Data_Faturamento") = Me.Txt_Data_Faturamento.Text
    Rs.Fields("Prazo_Entrega") = Me.Txt_N_Dias.Text

    'Se Data da Ocorrência estiver em Branco apresenta a mensagem de erro.
    Else
    MsgBox "Campo DATA OCORRÊNCIA não pode ficar em branco", vbCritical, "Eixo Sul"
    Me.Txt_Data_Ocorrencia.SetFocus
    Exit Sub
    End If

    'Efetiva a atualização do BD
    Rs.Update
    MsgBox "Cadastro da Devolução Realizado com Sucesso", vbInformation, "Sistema Devolução"
    Call LimparDados
    Me.Txt_Nota_Fiscal.SetFocus

sai:
   If Err Then
        texto = "Nota Fiscal já cadastrada, Verifique o número ou vá em CONSULTA para Editar"
        mensagem = MsgBox(texto, vbOKOnly + vbInformation, "Eixo Sul")
        Unload Me
    End If
End Sub

 
Postado : 03/06/2018 6:45 pm