Olá pessoal! Antes do início, queria avisar que estou tentando responder a todos os e-mail´s, o mais rápido possível, e podem aguardar que responderei a todos.

Essa semana vamos iniciar a abordagem sobre conexão com banco de dados, usado amplamente no dia-a-dia do programador. Serão usados nesta e nas próximas colunas os bancos ACCESS 2000/97, MS-SQL Server e MYSQL. O tipo de conexão a ser utilizada será a string para conexão ADO.

Para exemplificar esses três tipos de conexão, vamos criar uma aplicação simples de Agenda Telefônica.

Nesta primeira parte vamos usar o banco ACCESS. Crie um banco com o nome de agenda.mdb e com as seguintes características:

Tabela: pessoal
Campo	Tipo	Tamanho
codigo	AutoNumber
nome	Text	50
end	Text	100
fone	Text	25

No Visual Basic crie um novo Projeto com nome de AgendaMDB, renomeie o Form1 para frmAgenda e insira um Módulo com o nome de modCnn, como mostra a figura abaixo:

Agora vamos criar dentro do Módulo o código de conexão com o banco, e as rotinas de Inclusão, Consulta, Alteração e Exclusão como mostra as linhas abaixo:

Option Explicit

Global cn As ADODB.Connection
Global rs As ADODB.Recordset

Conexão:
Private Sub Main()
Dim strArquivo As String
Dim strLocal As String
Dim ConectaAccess As String

Load frmAgenda
frmAgenda.Show
DoEvents
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

strArquivo = "agenda.mdb"
strLocal = App.Path
Set cn = CreateObject("ADODB.Connection")
ConectaAccess = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=" & strArquivo & ";" & _
"DefaultDir=" & strLocal & ";" & _
"Uid=Admin;Pwd=;"

cn.Open ConectaAccess
End Sub

Rotina de Inclusão:
Public Function Inserir(ByVal strNome As String, _
strEnd As String, _
strFone As String) As Variant

cn.Execute ("insert into pessoal(nome,end,fone)" _
& "values('" & strNome & "','" & strEnd & "','" & strFone & "')")

Inserir = True
End Function

Rotina de Alteração:
Public Function Alterar(ByVal intCodigo As Integer, _
strNome As String, _
strEnd As String, _
strFone As String) As Variant

cn.Execute "update pessoal set nome= '" & strNome & "'," _
& " end= '" & strEnd & "', fone= '" & strFone & "'" _
& " where codigo = " & intCodigo

Alterar = True
End Function

Rotina de Consulta:
Public Function Consultar(ByVal intCodigo As Integer) As Variant
Set rs = CreateObject("ADODB.Recordset")

With rs
.Open "select * from pessoal where codigo=" & intCodigo & "", cn, adOpenKeyset, adLockOptimistic
If .RecordCount = 0 Then
MsgBox "Código Inválido", vbExclamation, "Erro"
Else
frmAgenda.lblCod = !codigo
frmAgenda.txtNome = IIf(IsNull(!nome), Empty, !nome)
frmAgenda.txtEnd = IIf(IsNull(!End), Empty, !End)
frmAgenda.txtFone = IIf(IsNull(!fone), Empty, !fone)
End If
.Close
End With

End Function

Rotina de Exclusão:
Public Function Excluir(ByVal intCodigo As Integer) As Variant

cn.Execute "delete * from pessoal where codigo=" & intCodigo & ""
Excluir = True
End Function

Para esse código que acabamos de digitar tenha efeito é necessário fazer uma referência ao ADO. Então clique em Project/References... e escolha a opção "Micrisoft ActiveX Data objects 2.6 Library", como mostra a figura abaixo:"

Obs.: As versões 2.5 e 2.6 do ADO são para ACCESS 2000 e a versão 2.1 é para ACCESS 97.

Voltando ao form frmAgenda modele-o como mostra a figura abaixo:

E o código desse form vai ficar dessa forma:

Botão Alterar:
Private Sub cmdAlterar_Click()
Dim atual As Variant

atual = Alterar(lblCod.Caption, txtNome.Text, txtEnd.Text, txtFone.Text)
If atual = True Then
Call limpar
Else
MsgBox "Erro na atualização.", vbCritical
End If
End Sub

Botão Consultar:
Private Sub cmdConsultar_Click()
Dim intCodigo As Integer
intCodigo = InputBox("Digite o Código", "Consulta")
Consultar (intCodigo)
End Sub

Botão Excluir:
Private Sub cmdExcluir_Click()
Dim excluido As Variant

excluido = Excluir(lblCod.Caption)
If excluido = True Then
Call limpar
Else
MsgBox "Erro na excluisão.", vbCritical
End If
End Sub

Botão Incluir:
Private Sub cmdIncluir_Click()
Dim novo As Variant

novo = Inserir(txtNome.Text, txtEnd.Text, txtFone.Text)
If novo = True Then
Call limpar
Else
MsgBox "Erro na incluisão.", vbCritical
End If
End Sub

Função limpar:
Private Sub limpar()
lblCod.Caption = ""
txtNome.Text = ""
txtEnd.Text = ""
txtFone.Text = ""
End Sub

Botão Sair
Private Sub cmdSair_Click()
cn.Close
Set cn = Nothing
Unload Me
End Sub

Para finalizar, clique em ProjectAgendaMDB Proprerties... e em Startup Object: troque frmAgenda por Sub Main.

Semana que vem vamos iniciar o exemplo desse projeto com conexão para SQL Server e também vamos usar procedures.

Abraços a todos e até a próxima coluna.