Dao E Ado

[Humm]

bom, peguei um codigo de exemplo mas não consigo aplica-lo no meu programa.

estou desconfiado que a conexao do meu é ADO e esse codigo foi feito com DAO e por isso n deve funcionar

como faco pra saber qual tipo de conexao estou usando na minha aplicacao access?

como posso fazer um codigo DAO funcionar em ADO?

Option Compare Database
Option Explicit

' Desenvolvido por JR - <accessjr@bol.com.br>
' Brasília - DF, em Jan/1999.
' http://www.accessjr.cjb.net

' Estas variáveis permanecerão abertas enquanto
' o formulário estiver aberto para agilizar
' as buscas subseqüentes.
Dim rs As DAO.Recordset, Rs1 As DAO.Recordset
Dim mValor As Variant

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Set rs = Nothing   'Libera memória
    Set Rs1 = Nothing
End Sub

Private Sub cmdCancelar_Click()
On Error Resume Next
    DoCmd.Close
End Sub

Private Sub cmdSeguir_Click()
On Error GoTo Err_cmdExibir
    With lstRetorno
        If .ListCount = 0 Then GoTo Termina
    End With

    MsgBox "Aqui você coloca o seu código para" _
      & vbCrLf & "usar o item selecionado na listbox."

Termina:
    Exit Sub
    
Err_cmdExibir:
    Select Case Err
    Case 94
        MsgBox "Selecione um Nome na caixa de listagem.", vbInformation, "Informação"
    Case Else
        MsgBox Err.Description, vbCritical, "Erro"
    End Select
    Resume Termina
    
End Sub

Private Sub cmdLimpar_Click()
On Error Resume Next
    txtPesquisa = ""
    txtPesquisa.SetFocus
    Rs1.Close
    lstRetorno.Requery
    lblSelecionadas.Caption = "Nenhum Nome Selecionado"
End Sub

Private Sub lstRetorno_DblClick(Cancel As Integer)
On Error Resume Next
    Call cmdSeguir_Click
End Sub

Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado

Pesquisa:
    mValor = txtPesquisa.Text
    If Len(mValor & "") = 0 _
        Or Asc(mValor) = 32 Then 'Limpa espaços também.
        Call cmdLimpar_Click
        Exit Sub
    End If

    'Na primeira vez, a rotina desviará para o rótulo
    'Rs_Fechado, pois o Recordset ainda não foi aberto.
    'Na 2ª vez em diante, a rotina prossegue normalmente.
    With rs
        .Filter = "NOME Like '*" & adhHandleQuotes(mValor, "'") & "*'"
        Set Rs1 = .OpenRecordset
        'Move para último p/ fazer contagem na função PreencheLista
        If Rs1.RecordCount <> 0 Then Rs1.MoveLast
        lstRetorno.Requery
    End With

Fim:
    Exit Sub

Rs_Fechado:
    Select Case Err
    Case 91, 3420  'Ocorre só na primeira vez em que é pesquisado um item.
        strSQL = "SELECT NOME, CODE " _
            & "FROM CLIENTES ORDER BY NOME"
        'Cria um recordset bem rápido, pois é SnapShot.
        Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
        GoTo Pesquisa
    Case 5  'ocorre ao voltar com BackSpace, apagando o texto.
        Resume Next
    Case Else
        MsgBox "Erro nº " & Err & vbCrLf _
          & Err.Description, vbCritical, "Erro"
    End Select
    Resume Fim

End Sub

Function PreencheLista(ctl As Control, varID As Variant, lngRow As Long, _
                       lngCol As Long, intCode As Integer) As Variant

    'Função CallBack padrão para preencher Combo/List box.
    On Error GoTo Err_Preenche

    Dim valret As Variant 'Retorno p/ cada um dos intCode indicados em Select Case.
    Dim I As Integer
    Static strNome() As Variant   'cria matriz dinâmica
    Static sContaReg As Integer
    sContaReg = Rs1.RecordCount
    I = 0
    valret = Null
    Select Case intCode
        Case acLBInitialize             ' Inicializa.
            With Rs1
                ReDim strNome(sContaReg, 1) 'redimensiona conforme nº linhas do recordset
                .MoveFirst
                For I = 0 To sContaReg - 1
                    strNome(I, 0) = !NOME
                    strNome(I, 1) = !CODE
                    .MoveNext
                Next I
            End With
            valret = True 'deve ser diferente de zero ou Null para prosseguir.

        Case acLBOpen               ' Abre.
            valret = Timer      ' Gera Código exclusivo.
        Case acLBGetRowCount        ' Obtém linhas.
            valret = -1         ' significa desconhecido
        'Case acLBGetColumnCount    ' Obtém colunas.
            'valret = 2
        'Case acLBGetColumnWidth    ' Obtém a largura da coluna.
            'valret = -1        ' Utiliza a largura padrão.
        Case acLBGetValue           ' Obtém os dados.
            valret = strNome(lngRow, lngCol)
        Case acLBEnd                'Fim
            Erase strNome           'limpa a matriz.
    End Select
    PreencheLista = valret  'preenche a Listbox
    lblSelecionadas.Caption = sContaReg & " Nome(s) Selecionado(s)"
    Exit Function

Err_Preenche:
    Select Case Err
    Case 9, 91    ' Erro gerado na 1ª vez que abrir
        Resume Next
    Case 3420, 3021      ' Causado pelo botão Limpar (Rs1.Close)
        PreencheLista = Null
    Case Else
        MsgBox "Erro nº " & Err & vbCrLf _
          & Err.Description, vbCritical, "Erro"
    End Select
    
End Function

[Humm]

galera.. deem uma força ai! hehe

[kuroi]

isso é tipo vba no access, certo?? talvez, fosse melhor você ter postado na sala de vba, peca pro moderador mover o tópico pra você

[Humm]

é vba para access mesmo. mas.. como é para access, por isso postei aqui.

[Humm]

alguém pode mover pra VBA ?? já que aqui não surtiu efeito.