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