Visual Basic 6
- Cadastro de Clientes completo com ADO
Esta começando agora com o Visual
Basic e quer um exemplo completo de uma aplicação que faz
acesso a banco de dados e realiza as operações para incluir ,
alterar , excluir , pesquisar e ainda que emita um relatório ???
![]()
Pois você chegou ao lugar certo
pois neste artigo eu apresento uma aplicação para cadastro de
clientes feita no Visual Basic versão 6 com acesso a um banco de dados
Access usando ADO e com relatório feito no Data Report.
![]()
A tela principal do sistema é vista a seguir:

O programa usa uma rotina sub main() para verificar se já existe uma instância da aplicação em execução, neste caso a mesma será encerrada.
Em seguida é obtido o caminho do banco de dados Clientes.mdb ( você pode definir o caminho no arquivo config.ini) e feita a abertura da base de dados que usa a senha MasterDB.
Sub Main()
Dim Caminho As String
If App.PrevInstance = True Then
Dim Form As Form
For Each Form In Forms
MsgBox "O Sistema já foi Iniciado", vbInformation, ""
Unload Form
Set Form = Nothing
Next Form
End
End If
'Caminho = ReadINI("Caminho", "BD", App.Path & "\Config.ini")
Caminho = App.Path & "\Clientes.mdb"
On Error GoTo Finalizar
cnSQL.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source =" & Caminho & ";Jet OLEDB:database Password=MasterDB"
frmCadClientes.Show
Exit Sub
Finalizar:
MsgBox "Erro Conectando-se ao Banco de Dados.", vbCritical, "Erro"
End Sub
|
O formulário de pesquisa de registros na tabela do banco de dados é mostrado abaixo:

Ele é usado para localizar os registros nas operações de alteração e exclusão de dados e foi criado usando um controle MSFlexGrid que é preenchido pela rotina MontarLista():
rivate Sub MontarLista()
Dim RS As New ADODB.Recordset
Dim SQL As String
Dim Criterio As String
grdPesquisa.TextMatrix(0, 0) = "CodCliente"
grdPesquisa.TextMatrix(0, 1) = "Telefone"
grdPesquisa.TextMatrix(0, 2) = "Nome"
Criterio = Chr$(39) & txtDadosPesquisa & "%" & Chr(39)
SQL = "SELECT CodCliente, Telefone, Nome FROM CadCliente WHERE CadCliente.Nome Like " & Criterio & " ORDER BY Nome"
On Error Resume Next
With RS
.Open SQL, cnSQL, adOpenForwardOnly, adLockReadOnly
If .EOF Then
MsgBox "Registro não encontrado", vbExclamation, "Atenção"
Limpa
grdPesquisa.TextMatrix(1, 0) = ""
grdPesquisa.TextMatrix(1, 1) = ""
grdPesquisa.TextMatrix(1, 2) = ""
Else
Limpa
Do Until .EOF
grdPesquisa.AddItem RS(0) & vbTab & RS(1) & vbTab & RS(2)
.MoveNext
Loop
grdPesquisa.RemoveItem 1
End If
.Close
End With
End Sub
|
A rotina usada para gravar as alterações e a inclusão de um novo registro é a seguinte:
Private Sub GravaDados()
Dim adCmdPaciente As New ADODB.Command
Dim CodCliente As Long
Dim Resp As Byte
If Not TudoOK Then Exit Sub
Resp = MsgBox("Confirma Gravação de " & txtNome & " em Cadastro de Cliente ?", vbYesNo + vbQuestion, "Salvar Dados")
If Resp = 7 Then Exit Sub
'On Error Resume Next
CodCliente = Val(txtCodCliente.Text)
With adCmdPaciente
Set .ActiveConnection = cnSQL
.CommandType = adCmdText
.Prepared = True
If CodCliente > 0 Then
.CommandText = "UPDATE CadCliente set Nome = ?, Endereco = ?, Bairro = ?, Cidade = ?, Estado = ?, Cep = ?, Telefone = ?, Obs = ?, DataCad = ? Where _
CodCliente = " & CodCliente
.Parameters.Append .CreateParameter("Nome", adVarChar, adParamInput, 30)
.Parameters.Append .CreateParameter("Endereco", adVarChar, adParamInput, 30)
.Parameters.Append .CreateParameter("Bairro", adVarChar, adParamInput, 20)
.Parameters.Append .CreateParameter("Cidade", adVarChar, adParamInput, 20)
.Parameters.Append .CreateParameter("Estado", adVarChar, adParamInput, 2)
.Parameters.Append .CreateParameter("Cep", adVarChar, adParamInput, 9)
.Parameters.Append .CreateParameter("Telefone", adVarChar, adParamInput, 9)
.Parameters.Append .CreateParameter("Obs", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("DataCad", adDate, adParamInput)
.Parameters("Nome") = txtNome.Text
.Parameters("Endereco") = txtEndereco.Text
.Parameters("Bairro") = txtBairro.Text
.Parameters("Cidade") = txtCidade.Text
.Parameters("Estado") = cboEstado.Text
.Parameters("Cep") = txtCep.Text
.Parameters("Telefone") = txtTelefone.Text
.Parameters("Obs") = txtObs.Text
.Parameters("DataCad") = Date
.Execute
If Err.Number <> 0 Then
MostraErro
End If
Else
.CommandText = "INSERT INTO CadCliente (Nome, Endereco, Bairro, Cidade, Estado, Cep, Telefone, Obs, DataCad) Values (?, ?, ?, ?, ?, ?, ?, ?, ?)"
.Parameters.Append .CreateParameter("Nome", adVarChar, adParamInput, 30)
.Parameters.Append .CreateParameter("Endereco", adVarChar, adParamInput, 30)
.Parameters.Append .CreateParameter("Bairro", adVarChar, adParamInput, 20)
.Parameters.Append .CreateParameter("Cidade", adVarChar, adParamInput, 20)
.Parameters.Append .CreateParameter("Estado", adVarChar, adParamInput, 2)
.Parameters.Append .CreateParameter("Cep", adVarChar, adParamInput, 9)
.Parameters.Append .CreateParameter("Telefone", adVarChar, adParamInput, 9)
.Parameters.Append .CreateParameter("Obs", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("DataCad", adDate, adParamInput)
.Parameters("Nome") = txtNome.Text
.Parameters("Endereco") = txtEndereco.Text
.Parameters("Bairro") = txtBairro.Text
.Parameters("Cidade") = txtCidade.Text
.Parameters("Estado") = cboEstado.Text
.Parameters("Cep") = txtCep.Text
.Parameters("Telefone") = txtTelefone.Text
.Parameters("Obs") = txtObs.Text
.Parameters("DataCad") = Date
.Execute
If Err.Number <> 0 Then
MostraErro
End If
End If
End With
Set adCmdPaciente = Nothing
cmdNovo_Click
End Sub
Public Sub MostraDadosCliente()
Dim rsPaciente As New ADODB.Recordset
Dim SQL As String
Dim CodCliente As Long
CodCliente = Val(txtCodCliente.Text)
On Error Resume Next
SQL = "SELECT Nome, Endereco, Bairro, Cidade, Estado, Cep, Telefone, Obs From CadCliente Where CodCliente=" & CodCliente
rsPaciente.Open SQL, cnSQL, adOpenForwardOnly, adLockReadOnly
txtNome = rsPaciente(0)
txtEndereco = rsPaciente(1)
txtBairro = rsPaciente(2)
txtCidade = rsPaciente(3)
cboEstado = rsPaciente(4)
txtCep = rsPaciente(5)
txtTelefone = rsPaciente(6)
txtObs = rsPaciente(7)
rsPaciente.Close
End Sub
|
Perceba que foram usadas instruções SQL para atualizar (UPDATE) e para incluir um novo cliente (INSERT INTO) com a utilização de parâmetros
| UPDATE CadCliente set Nome
= ?, Endereco = ?, Bairro = ?, Cidade = ?, Estado = ?,
Cep = ?, Telefone = ?, Obs = ?, DataCad = ? Where _ CodCliente = " & CodCliente |
| INSERT INTO CadCliente (Nome, Endereco, Bairro, Cidade, Estado, Cep, Telefone, Obs, DataCad) Values (?, ?, ?, ?, ?, ?, ?, ?, ?)" |
O formulário para exibir o relatório permite a seleção entre um intervalo de datas:

O código para a seleção é dado a seguir:
Private Sub cmdOK_Click() Dim DataInicial As String Dim DataFinal As String DataInicial = Format(actDataInicial.Value, "mm/dd/yyyy") DataFinal = Format(actDataFinal.Value, "mm/dd/yyyy") dteRelatorio.cmdClientes_Data DataIncial, DataFinal Unload Me dtrClientes.Show 1 End Sub |
O relatório da aplicação feita no Data Report tem o seguinte leiaute:
![]() |
Na verdade uma aplicação simples mas que ensina os passos básicos para conexão e manutenção de dados usando ADO. Além disso o sistema possui diversas rotinas interessantes para você estudar.
O projeto completo esta no Super DVD Visual Basic.
|
Veja os
Destaques e novidades do SUPER DVD VB 2013
(sempre atualizado) : clique e confira !
Quer migrar para o VB .NET ? Veja mais sistemas completos para a plataforma .NET no Super DVD .NET , confira... Quer aprender C# ?? Chegou o Super DVD C# 2013 com exclusivo material de suporte e vídeo aulas com curso básico sobre C#. |
Eu sei é apenas Visual Basic , mas
eu gosto... ![]()
Referências:
José Carlos Macoratti