Preencher List Box Por Textbox

[Ceh]

Pessoal, estou com um problema aqui! Preciso fazer uma busca no bd cada vez que um usuário pressiona uma tecla e colocar o resultado em um listbox... eu até tenho um código aqui, mas não funciona... vou postar aqui para ver se alguém consegue me ajudar.

Private Sub Txtpesquisa_Change()
    Dim I As Integer
    Dim J As Integer
    Dim aux As String
    Dim SQL As String
    Dim Sansql As String
    Dim db As Database
    Dim rs As Recordset
    Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path + "\..\db1.mdb")
    Set rs = db.OpenRecordset("CAD_PART")
    LstPesquisa.Clear
    If Txtpesquisa <> "" Then
        J = Len(Txtpesquisa)
        J = J Mod Letras
        If J <> 0 Then
            Exit Sub
        End If
            SQL = "Select * from cad_part where nome like '" + Txtpesquisa + "%' order by nome"
                Set rs = db.OpenRecordset(SQL)
        If rs.RecordCount > 0 Then
            Do While Not rs.EOF
               LstPesquisa.AddItem rs.Fields(0)
               rs.MoveNext
            Loop
        End If
        rs.Close
    End If
End Sub

Não ocorre nenhum erro, mas também não preenche o listbox quando eu pressiono uma tecla!

[ ]'s

[cyberalexxx]

Private Sub Txtpesquisa_Change()

  Dim I As Integer

  Dim J As Integer

  Dim aux As String

  Dim SQL As String

  Dim Sansql As String

  Dim db As Database

  Dim rs As Recordset

  Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path + "\..\db1.mdb")

  Set rs = db.OpenRecordset("CAD_PART")

  LstPesquisa.Clear

  If Txtpesquisa.text <> "" Then

      J = Len(Txtpesquisa.text)

      J = J Mod Letras

      If J <> 0 Then

          Exit Sub

      End If

          SQL = "Select * from cad_part where nome like '" + Txtpesquisa.text + "%' order by nome"

              Set rs = db.OpenRecordset(SQL)

      If rs.RecordCount > 0 Then

          Do While Not rs.EOF

              LstPesquisa.AddItem rs.Fields(0)

              rs.MoveNext

          Loop

      End If

      rs.Close

  End If

End Sub

[Ceh]

Continua a mesma coisa!! Não dá erro, mas também não preenche o listbox.

[ ]'s

[cyberalexxx]

fiz um rapidinho aki e funfou, ficou assim:

Private Sub Text1_Change()
    Dim conecta As New ADODB.Connection
    conecta.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\Administrador\Meus documentos\fontes\teste\produtos.mdb;"
    conecta.Open
    Dim rs As New ADODB.Recordset
    List1.Clear
    sql = "Select * from linhas where descricao like '" & Text1.Text & "%'"
    Set rs = conecta.Execute(sql)
    Do While Not rs.EOF
        List1.AddItem rs("descricao")
        rs.MoveNext
    Loop
End Sub

é só adaptar seus dados que vai funcionar e é claro dar uma organizada na conexão e coloca-la em um modulo, para não ficar criando a conexão a cada alteração no campo texto.

[brunohjoia]

Olá! Eu detectei dois possíveis erros no código que você estava usando. O 1° pode ser resolvido fazendo a seguinte alteração no seu código:

Private Sub Txtpesquisa_Change()

  Dim I As Integer

  Dim J As Integer

  Dim aux As String

  Dim SQL As String

  Dim Sansql As String

  Dim db As Database

  Dim rs As Recordset

  Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path + "\..\db1.mdb")

  Set rs = db.OpenRecordset("CAD_PART")

  LstPesquisa.Clear

  If Txtpesquisa <> ""  or txtpesquisa<>empty Then

      J = Len(Txtpesquisa)

      J = J Mod Letras

      If J <> 0 Then

          Exit Sub

      End If

          SQL = "Select * from cad_part where nome like '" + Txtpesquisa + "%' order by nome"

              Set rs = db.OpenRecordset(SQL)

      If rs.RecordCount > 0 Then

          Do While Not rs.EOF

              LstPesquisa.AddItem rs.Fields(0)

              rs.MoveNext

          Loop

      End If

      rs.Close

  End If

End Sub

Um segundo possível problema é a variável Letras. Pelo que eu ví esta variável nem foi declarada na sua rotina e, portanto, está vazia, o que pode ser a razão do seu problema. Mas mesmo que ela já tenha sido declarada fora da rotina, fique atenta ao valor que ela está contendo porque dependendo do seu valor, quando a linha "J = J Mod Letras" for executada, ela pode fazer com que J fique com valor <> de 0, o que aciona a instrução "Exit Sub". Esta instrução, ao ser acionada, pára de executar a rotina sem acusar erro algum. Acho que é isso!

[Ceh]

Pessoal, já consegui colocar tudo no listbox, mas surgiu outro problema... rssss

Ex: Eu digito a letra p(seleciona todo mundo com p), mas se eu continuo digitando paulo(não muda só para os nomes que começam com paulo), Aparece tb, Pablo, Patricia etc... aparecem todos que comecam com a letra p, mas as outras letras que eu digitei não!

Eu já separei tudo, tem uma parte só com o banco(módulo). Não sei porque não vai mudando se eu coloquei inclusive no evento Change.

[ ]'s

[cyberalexxx]

tentou da forma que eu fiz???

Poste como esta seu código agora.

[Ceh]

Do jeito que você postou deu erro, então fiz assim e funcionou, mas só na primeira letra, não entendo porque, se eu coloquei o evento Change.

##Formulário##

Private Sub txtUsuario_Change()
    Dim usuario, senha
    usuario = txtUsuario.Text
    senha = txtSenha.Text
    
    Call Conecta(caminho)
    
    Dim strSQL, rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    strSQL = " SELECT *" & _
             " FROM cad_part" & _
             " WHERE nome  Like'" & Trim(usuario) & "%' " & _
               "order by nome"
    rs.Open strSQL, GotoAccess, adOpenKeyset, adLockOptimistic
    
    If rs.RecordCount > 0 Then
            Do While Not rs.EOF
               Lstpesquisa.AddItem rs.Fields(5)
               rs.MoveNext
            Loop
    End If

End Sub

##Módulo##

Public caminho, usuario, senha, GotoAccess, strSQL
Function Conecta(caminho)

Dim sLocal As String
Dim Access As String

sLocal = App.Path

DoEvents

Set GotoAccess = New ADODB.Connection

    Set GotoAccess = CreateObject("ADODB.Connection")
    Access = "Driver={Microsoft Access Driver (*.mdb)};" & _
    "Dbq= C:\vb\db1.mdb;" & _
    "DefaultDir=" & sLocal & ";"
    GotoAccess.Open Access
    
End Function

[ ]'s

[Ceh]

Consegui... valeu pela ajuda de todos. O que estava faltando era eu limpar o listbox cada vez que eu pressionar outra tecla.

Moderaror, pode fechar o tópico.

[ ]'s