(Resolvido) misterio com rotina

[Humm]

há um tempo atras achei um codigo na internet pra criar um formulario de pesquisa de dados.

naquela epoca funcionou direitinho, e ainda funciona no projeto da epoca.

acontece que agora to tentando usar o mesmo codigo num outro projeto e to tendo um erro esquisito.

o codigo é:

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 cmdExibir_Click()
On Error GoTo Err_cmdExibir
    With lstRetorno
        If .ListCount = 0 Then GoTo Termina
    End With

    Forms!Alunos!Nome = Me.lstRetorno
    DoCmd.Close acForm, "LOCALIZAR_CLIENTE"
        
Termina:
    Exit Sub
    
Err_cmdExibir:
    Select Case Err
    Case 94
        MsgBox "Selecione um Aluno 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 Aluno Filtrado"
End Sub

Private Sub lstRetorno_DblClick(Cancel As Integer)
On Error Resume Next
    Call cmdExibir_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 = Me.FindBy & " 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 COD, Matr, Nome, Telefone, Celular, Bairro " _
            & "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, 5) 'redimensiona conforme nº linhas do recordset
                .MoveFirst
                For I = 0 To sContaReg - 1
                    strNome(I, 0) = !COD
                    strNome(I, 1) = !Matr
                    strNome(I, 2) = !Nome
                    strNome(I, 3) = !Telefone
                    strNome(I, 4) = !Celular
                    strNome(I, 5) = !Bairro
                    .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 & " Aluno(s) Filtrado(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

o erro acontece quando vou usar o form de pesquisa e digito algo. ai da erro:

Erro de compilação:

Sub ou Fuction não definida.

e ele marca o .FindBy abaixo:

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 = Me.FindBy & " Like '*" & adhHandleQuotes(mValor, "'") & "*'"

alguém tem ideia do que possa ser?

já verifiquei se era falta da referencia Microsoft DAO 3.6 mas no access 2007 ela já vem como padrão.

Editado Agosto 17, 2010 por Humm

[Humm]

resolvi o misterio.

faltou eu colocar um modulo que faz parte do codigo.

Attribute VB_Name = "basHandleQuotes"
Option Compare Database
Option Explicit

' Desenvolvido por
' Litwin, Getz, e Gilbert.
' Access 97 Developer's Handbook (Sybex)
' Copyright 1997.

' Para usar este código, mantenha as linhas acima.

Function adhHandleQuotes(ByVal varValue As Variant, _
    ByVal strDelimiter As String) As Variant

' Replace all instances of strdelimiter with varValue with TWO instances,
' thereby handling the darned quote issue once and for all.

' Returns Null if varValue was Null, otherwise
' returns varValue with all instances of strDelimiter
' replaced with two of each.
' HandleQuotes("This 'is' a test", "'") returns
'   "This ''is'' a test"
    
    adhHandleQuotes = Replace(varValue, strDelimiter, strDelimiter & strDelimiter)
End Function

Function Replace(ByVal varValue As Variant, _
    ByVal strFind As String, ByVal strReplace As String) As Variant

    ' Replace all instances of strFind with strReplace in varValue.
    
    Dim intLenFind As Integer
    Dim intLenReplace As Integer
    Dim intPos As Integer
    
    If IsNull(varValue) Then
        Replace = Null
    Else
        intLenFind = Len(strFind)
        intLenReplace = Len(strReplace)
        
        intPos = 1
        Do
            intPos = InStr(intPos, varValue, strFind)
            If intPos > 0 Then
                varValue = Left(varValue, intPos - 1) & strReplace & Mid(varValue, intPos + intLenFind)
                intPos = intPos + intLenReplace
            End If
        Loop Until intPos = 0
    End If
    Replace = varValue
End Function