Tentei as duas orientacoes acima, porem agora esta me dando outro erro, e não consigo visualizar. estou colando o codigo completo, conexao, rotina de inclusa que funciona normalmento e rotina de consulta que esta dando erro, talves facilite pra visualizar algum erro, o erro que esta dando agora é THE CONECTION BE NOT USED TP PERFORM THIS OPERATION. IT IS EITHER CLOSED OR INVALID IN THIS CONTEXT. Fico no aguardo de ajudas. 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 frmPrincipal
frmPrincipal.Show
DoEvents
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strArquivo = "usuarios.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, _
strresid As String, strcel As String, strnextel As String, strramal As String, _
strrecado As String) As Variant
cn.Execute ("insert into fones(Nome,Residencial,Celular,Nextel,Ramal,recado)" _
& "values('" & strnome & "','" & strresid & "','" & strcel & "','" & strnextel & "','" & strramal & "','" & strrecado & "')")
Inserir = True
End Function
'Rotina de Consulta
Public Function Consultar(ByVal intnome As String)
Set rs = CreateObject("ADODB.Recordset")
With rs
.Open "select * from fones where nome = " & intnome & ", cn, adOpenKeyset, adLockOptimistic"
If .RecordCount = 0 Then
MsgBox "Nome Inválido", vbExclamation, "Erro"
Else
frmconsfone.lblnome = IIf(IsNull(!nome), Empty, !nome)
frmconsfone.lblresid = IIf(IsNull(!residencial), Empty, !residencial)
frmconsfone.lblcel = IIf(IsNull(!celular), Empty, !celular)
frmconsfone.lblnextel = IIf(IsNull(!nextel), Empty, !nextel)
frmconsfone.lblramal = IIf(IsNull(!ramal), Empty, !ramal)
frmconsfone.lblrecado = IIf(IsNull(!recado), Empty, !recado)
End If
.Close
End With
End Function Obrigado a todos.