[Resolvido] Problemas para Atualizar Banco de Dados

[Beavis440 0]

Pessoal estou fazendo um projeto de sistema de cadastro, porem como o formulário é grande, quando vou salvar o botão fica selecionando mas não salva.

 

Segue a baixo o código.

 

    Dim Aquivo As String
   Dim Comando As String
   Dim SQL As String
   Dim Conexao As ADODB.Connection
   Dim Tabela As ADODB.Recordset

Private Function Abre_Conexao()
       Arquivo = App.Path & "\Dados.mdb"
   Comando = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Arquivo & ""
   Set Conexao = New ADODB.Connection
   With Conexao
       .ConnectionString = Comando
       .Open
   End With
   Set Tabela = New ADODB.Recordset
End Function

Private Function Fecha_Conexao()
   Tabela.Close
   Set Tabela = Nothing
   Conexao.Close
   Set Conexao = Nothing
End Function

Public Function CadastrarUsuario()
   Abre_Conexao
       SQL = "Select * From [CadClientes]"
       Tabela.Open SQL, Conexao, adOpenDynamic, adLockOptimistic
           If Not Tabela.EOF Then
           With Tabela
               .AddNew
               Tabela("CPF") = txtCPF
               Tabela("Cliente") = txtClientes
               Tabela("Empresa") = txtEmpresa
               Tabela("ResInforma") = txtResInfomacao
               Tabela("Endereco") = txtEndereco
               Tabela("Bairro") = txtBairro
               Tabela("Cidade") = txtCidade
               Tabela("Estado") = txtEstado
               Tabela("Telefone") = txtTelefone
               Tabela("Celular") = txtCelular
               Tabela("CEP") = txtCEP
               Tabela("RG") = txtRG
               Tabela("LocTrabalho") = txtLocTrabalho
               Tabela("Veiculo") = txtVeiculo
               Tabela("Marca") = txtMarca
               Tabela("Ano") = txtAno
               Tabela("Cor") = txtCor
               Tabela("Placa") = txtPlaca
               Tabela("ResEmpresa") = txtResEmpresa
               Tabela("DataCadastro") = txtData
               Tabela("KM") = txtKM
               Tabela("OBS") = txtOBS
               .Update
           End With
           CadastraUsuario = True
       Else
           CadastraUsuario = False
       End If
   Fecha_Conexao
End Function

Private Sub cmdSalvar_Click()
   If CadastrarUsuario = True Then
       MsgBox "Cadastro realizado com sucesso", vbInformation, "Cadastro"
   End If
End Sub

 

Se puderem me ajudar agradeço

[KhaosDoctor 242]

Por favor, use o CODE quando for expressar códigos em seus posts. O BBCode é representado por dois sinais ( <> ) no topo do editor.

 

Qual é o erro que aparece?

[Beavis440 0]

Esse é o problema ele não acusa erro nenhum, até usei a mesmo estrutura para o formulário do Login e deu tudo certo. Nesse do cadastro quando vou aparta para salvar o botão fica selecionado e não faz nada, tipo que trava.

 

OBS. Peço desculpas ai pelo por conta do código ter sido posto de forma errada.

[KhaosDoctor 242]

Já experimentou usar alguns breakpoints para ver linha por linha?

 

Você está retornando algum valor nas suas functions?

[Beavis440 0]

Khaos pra te falar a verdade faz um mês que iniciei no VB6, a parde de fazer breakpoints sei fazer e vou tentar aqui. Mas sobre a pergunta de retorna valores não entendo muito bem. você se refere de Valores do banco de dados para o VB6?

[KhaosDoctor 242]

Não, quando você chama uma function, como aqui:

 

 

Private Function Abre_Conexao()

       Arquivo = App.Path & "\Dados.mdb"
   Comando = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Arquivo & ""
   Set Conexao = New ADODB.Connection
   With Conexao
       .ConnectionString = Comando
       .Open
   End With
   Set Tabela = New ADODB.Recordset

End Function

 

 

 

Você deve retornar algum valor, um exemplo prático é soma:

 

Public function soma(a as double, b as double)

return a+b

end function

 

 

A clausula "Function" necessite de um argumento "Return" que retorna um valor para aquele qual o enviou, então se eu pedir:

 

Dim soma as double = Soma(2,2)

 

A variável do tipo double chamada soma vai executar a função Soma, que por sua vez retorna o resultado da adição dos dois números entre parenteses.

 

A mesma coisa ocorre aqui, veja que nenhum argumento é retornado:

 

 

Private Function Abre_Conexao()
       Arquivo = App.Path & "\Dados.mdb"
   Comando = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Arquivo & ""
   Set Conexao = New ADODB.Connection
   With Conexao
       .ConnectionString = Comando
       .Open
   End With
   Set Tabela = New ADODB.Recordset
End Function

 

 

Não creio que este seja a causa do problema, mas se não pretende retornar nada, apenas realizar uma ação e terminá-la, sugiro que use o sub:

 

 

Private Sub Abre_Conexao()
       Arquivo = App.Path & "\Dados.mdb"
   Comando = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Arquivo & ""
   Set Conexao = New ADODB.Connection
   With Conexao
       .ConnectionString = Comando
       .Open
   End With
   Set Tabela = New ADODB.Recordset
End Sub

 

 

Sugiro verificar se a conexão também está aberta ou fechada, neste caso ele deveria mandar uma mensagem de erro dizendo que a conexão não se abriu, o que torna altamente improvável que o erro aconteça.

 

Porém, o que eu acho que está acontecendo ai são duas coisas, primeiro, mude isso no final do código da função "CadastrarUsuario":

 

 

End With
           Return CadastraUsuario = True
       Else
           Return CadastraUsuario = False
       End If

 

 

O outro problema que posso tentar chutar que seja é que ele não está nem entrando no if e nem no else, ou seja, as condições não se completam, e como você mesmo escreveu no código do botão ok, se ele for True a mensagem aparece.

 

Sempre que for fazer uma verificação de mensagem, avisando ao usuário que a ação foi executada, adicione o if, MAS TAMBÉM ADICIONE O ELSE, assim se der errado você também saberá:

 

 

Private Sub cmdSalvar_Click()
   If CadastrarUsuario = True Then
       MsgBox "Cadastro realizado com sucesso", vbInformation, "Cadastro"

Else

MsgBox "Erro no cadastro"

   End If
End Sub

 

 

Sugiro que use uns Try Catch nas funções também:

 

https://www.google.com.br/webhp?sourceid=chrome-instant&ie=UTF-8&ion=1#hl=pt-BR&safe=off&sclient=psy-ab&q=try+catch+vb&oq=try+catch+vb&gs_l=hp.3..0l4.77.7278.0.7608.5.5.0.0.0.0.344.1180.0j3j0j2.5.0...0.0...1c.1.JZbT5Vrlfss&pbx=1&bav=on.2,or.r_gc.r_pw.r_cp.r_qf.&fp=999303293c3657e1&bpcl=37643589&ion=1&biw=1440&bih=775

[Beavis440 0]

Ata agora entendi, nossa muito obrigado pelo tamanho da explicação. A função com retorno esta feita no formulário de Login que funcionou perfeitamente que era assim:

 

A função no Módulo,

 

Public Function IncluiUsuario(Usuario As String, Senha As String)
   Abre_Conexao
   SQL = "Select * From [usuarios]"
   Tabela.Open SQL, Conexao, adOpenForwardOnly, adLockOptimistic
       If Not Tabela.EOF Then
           With Tabela
               .AddNew
               Tabela("Usuario") = Usuario
               Tabela("Senha") = Senha
               .Update
           End With
           IncluiUsuario = True
       Else
           IncluiUsuario = False
       End If
   Fecha_Conexao
End Function

 

E aqui para executar o Login

 

Private Sub cmdOK_Click()
   If ValidaUsuario(txtUsuario, txtSenha) = True Then
       MsgBox "Acesso efetuado com sucesso!", vbInformation, "Login"
       frmMenu.Show
       Unload Me
   Else
       MsgBox "Acesso negado", vbCritical, "Login"
   End If
End Sub

 

Tinha anteriormente feito nesse mesmo estilo, só que dai deu erro de Run time. Penso eu, não sei se é, que por conta da enorme quantidade de argumentos para retorno, 22 como esta no código que descrevi anteriormente, é que gerou esse erro.

Então acabei criando nesse outro método.

[KhaosDoctor 242]

O número de argumentos é indiferente, o VB executa em milissegundos, o que pode dar erro são argumentos que não batem com outros argumentos ou então redundancia.

[Beavis440 0]

Ok Khaos, gostaria de fazer só mais uma pergunta então.

Faço essas funções no Módulo então ou no próprio form.

Dez de já agradeço pela atenção. Me ajudou bastante.

 

Fui colocar o Return mas da erro "Expected: end of statement"

[KhaosDoctor 242]

Passe o trecho que deu erro por favor.

[Beavis440 0]

                .Update
           End With
Erro aqui>>>>    Return CadastraUsuario = True
           Else
              Return CadastraUsuario = False
           End If

[KhaosDoctor 242]

Você está chamando o nome da função duas vezes, isso é redundante, use somente "Return true" e "Return false"

[Beavis440 0]

Putz ta osso, colocando somente isso da o mesmo erro também.

[KhaosDoctor 242]

Você está colocando "Return = true" ou "Return true"?

 

Em qualquer caso se não funcionar, retire o return e deixe apenas como estava, o return da uma ideia mais ampla, mas como é VB6 então pode ser um pouco diferente.

[Beavis440 0]

Tentei as duas formas, e as duas estão dando o mesmo erro e no mesmo lugar.

 

Khaos fiz ser uma função como você havia me sugerido porem esta dando esse erro agora.

 

Public Function CadastraUsuario(CPF As String, Cliente As String, Empresa As String, ResInforma As String, Endereco As String, Bairro As String, Cidade As String, Estado As String, Telefone As String, Celular As String, CEP As String, RG As String, LocTrabalho As String, Veiculo As String, Marca As String, Ano As String, Cor As String, Planca As String, ResEmpresa As String, Data As String, KM As String, OBS As String)
   SQL = "Select * From [CadClientes]"
   Erro aqui >>>>>>Tabela.Open SQL, Conexao, adOpenForwardOnly, adLockOptimistic
       If Not Tabela.EOF Then
           With Tabela
               .AddNew
               Tabela("CPF") = CPF
               Tabela("Cliente") = Cliente
               Tabela("Empresa") = Empresa
               Tabela("ResInforma") = ResInforma
               Tabela("Endereco") = Endereco
               Tabela("Bairro") = Bairro
               Tabela("Cidade") = Cidade
               Tabela("Estado") = Estado
               Tabela("Telefone") = Telefone
               Tabela("Celular") = Celular
               Tabela("CEP") = CEP
               Tabela("RG") = RG
               Tabela("LocTrabalho") = LocTrabalho
               Tabela("Veiculo") = Veiculo
               Tabela("Marca") = Marca
               Tabela("Ano") = Ano
               Tabela("Cor") = Cor
               Tabela("Placa") = Placa
               Tabela("ResEmpresa") = ResEmpresa
               Tabela("Data") = Data
               Tabela("KM") = KM
               Tabela("OBS") = OBS
               .Update
           End With
               CadastraUsuario = True
           Else
               CadastraUsuario = False
           End If
End Function

 

Run time Error '3705'

Operação não permitida quando o objeto esta aberto

[Beavis440 0]

Problema Resolvido vou deixar descrito a baixo os problemas que tinha para o consulta dos demais membros que tiverem futuros erros parecidos.

Eu tinha 2 Subs no módulo que eram "Abrir_Conexao" e "Fechar_Conexao"

Ou criar uma Função "VerificarCadastro" Coloquei no início e no fim as Subs de abrir e fechar conexão.

Como segue a baixo.

 

Public Function VerificaCadastro(CPF As String)
   Abre_Conexao
       SQL = "Select * From [CadClientes] where CPF LIKE '" & CPF & "'"
       Tabela.Open SQL, conexao, adOpenForwardOnly, adLockReadOnly
   If Not Tabela.EOF Then
   Tabela.Close
       VerificaCadastro = True
   Else
       VerificaCadastro = False
   End If
   Fechar_Conexao
End Function

 

Bom o erro estava no fechar conexão.

A seguir iram entender.

 

Private Sub cmdSalvar_Click()
   Dim SQL As String
   Abre_Conexao2
   If VerificaCadastro(txtCPF.Text) = True Then
       MsgBox "Cliente ja Cadastrado!", vbInformation, "Cadastro"
   Else
       SQL = "Insert Into CadClientes(CPF, Cliente, Empresa, ResInforma, Endereco, Bairro, Cidade, Estado, Telefone, Celular, CEP, RG, LocTrabalho, Veiculo, Marca, Ano, Cor, Placa, ResEmpresa, Data, KM, OBS) Values('" & txtCPF.Text & "','" & txtCliente.Text & "','" & txtEmpresa.Text & "','" & txtResInfoma.Text & "','" & txtEndereco.Text & "','" & txtBairro.Text & "','" & txtCidade.Text & "','" & txtEstado.Text & "','" & txtTelefone.Text & "','" & txtCelular.Text & "','" & txtCEP.Text & "','" & txtRG.Text & "','" & txtLocTrabalho.Text & "','" & txtVeiculo.Text & "','" & txtMarca.Text & "'," & txtAno.Text & ",'" & txtCor.Text & "','" & txtPlaca.Text & "','" & txtResEmpresa.Text & "','" & txtData.Text & "'," & txtKM.Text & ",'" & txtOBS.Text & "')"
       conexao.Execute SQL
       MsgBox "Cadastro Realisado Com Sucesso!", vbInformation, "Cadastro"
       Limpa
   End If
   Fecha_Conexao2
End Sub

 

Bom como demonstra o código para salvar os dados. No início coloquei "Abre_Conexao" e depois chamo a Função "VereficaCadastro". Ai que deu o problema, com essa Funcão deixava minha sequência de linhas com a conexão fechada por ter colocado dentro dela abrir e fechar também. Então quando coloquei conexao.Execute SQL deu o erro por não estar conectado com o Bando de Dados.

Outros erro foram na questão de eu ter colocado mascaras de nas textbox e na tabela. Isso gerou conflito com a tabela. Fazendo mascaras no VB não é necessário fazer no Banco de Dados. Bem como quantidade de caracteres número ou texto.

Então para resolver o problemas apenas tirei o fechar conexão do Função "VerificarCadastro" e comecei a cuidar desses conflitos.

Peço que se tiver algum erro na minha explicação, que a moderação acerte pra mim.

Obrigado pela ajuda.

[KhaosDoctor 242]

Você poderia ter feito manualmente a abertura e o fechamento da conexão.