Criar uma agendinha no VB

[Sheila Azam 0]

Eu estou çomeçando a programar agora.

Queria saber pq não dá certo o programinha da minha agenda, que coipei no imaters para fazer um teste dá o seguinte erro.

-2147467259 Nome da fontes de Dados não encontrado e nenhum driver padrão especificado.

 

Aqui está a maneira que eu fiz

módulo

 

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={MicrosoftAccessDriver(*.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 & "," & " 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* form where codigo = " & intCodigo & ""

Excluir = True

 

End Function

 

 

e no form eu fiz assim

 

 

 

 

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

 

 

 

Private Sub cmdConsultar_Click()

Dim intCodigo As Integer

intCodigo = InputBox("Digite o Código", "Consulta")

Consultar (intCodigo)

 

 

End Sub

 

Private Sub cmdExcluir_Click()

Dim excluido As Variant

excluido = Excluir(lblCod.Caption)

If excluido = True Then

Call Limpar

Else

MsgBox "Erro na exclusão", vbCritical

End If

 

End Sub

 

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 inclusão", vbCritical

End If

 

 

End Sub

 

Private Sub Limpar()

lblCod.Caption = ""

txtNome.Text = ""

txtEnd.Text = ""

txtFone.Text = ""

End Sub

 

Private Sub cmdSair_Click()

cn.Close

Set cn = Nothing

Unload Me

 

End Sub

 

O que tem de errado???

[SANDRO LOPES 0]

Experimenta assim a conexão:Vá em Project=> References e vê se tá marcado "Microsoft Jet and Replication Objects 2.6 Library" e o "Microsoft ActiveX Data Objects 2.1 Library"Se não estiver marcado, marque.

ConectaAccess = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strlocal & "\" & strArquivo & " ;Jet OLEDB:Database Password=;"

[Sheila Azam 0]

Obrigado!!Deu certo.