Formulário de Pesquisa com várias "listboxes"

[Henrique Miranda]

Tomaz, tudo bem?
Primeiro gostaria de agradecer pelo empenho em fornecer todos estes conhecimentos a nós, e tirar estas dúvidas que nós, leigos, apresentamos aqui.

Andei "destrinchando" o modelo de cadastro (versão 2), para aprender a adaptá-lo as minhas necessidades, e consegui fazer muitas coisas, mas agora não consigo evoluir do seguinte problema:

Alterei o formulário de pesquisa, de forma a conter não apenas 1 listbox para escolha do filtro, mas várias delas. Ao fazer a pesquisa, elas funcionam perfeitamente, desde que eu utilize apenas 1 de cada vez.

Quando seleciono informações de 2 listboxes, ela não filtra corretamente, trazendo para o resultado do filtro mais informações do que deveria. Vou fazer um exemplo para entender melhor o que quero dizer:

Considere a seguinte tabela de dados:
1.... Joao..... amarelo
2.... Joao..... verde
3.... Jose..... Amarelo

Tenho 2 listboxes de filtro: uma para "nome" e outra para "cor".

Se eu filtro somente "joao", tenho os registros 1 e 2 como resultado. (perfeito)
Se eu filtro somente "amarelo", tenho os registros 1 e 3 como resultado. (perfeito)
Agora, se eu filtro "joao" e "amarelo" eu acabo tendo como resultado os registros 1, 2 e 3. Mas na verdade eu queria apenas o registro 1.

Como consigo fazer isto? Tentei alterar as "slqwhere" para AND, para OR, tanto na function "PreencheRecordSet" quanto na sub "MontaClausulaWhere" e nada de funcionar...

Procurei esta dúvida aqui antes de postar, mas não encontrei... Se ja tiver sido respondida, por favor me passe o link.

Muito Obrigado!!!

[webmaster]

Henrique,

O raciocínio está certo quanto a trabalhar no SQL. No caso do listboxes, caso o resultado do filtro seja exclusivo, então vai ter que mudar o OR entre as sentenças do listbox de OR para AND.

Para ajudar mais, só vendo o código.

Abraços

[Henrique Miranda]

Pois é, tentei alterar todas as combinacoes possiveis de OR e AND, mas nao consegui...

Abaixo, parte do codigo que montei (com a function "preencherecordset" e a Sub "montaclausulawhere")

Em azul, as duas listboxes. Deixei em vermelho onde suponho que esta o "pulo do gato". Tentei inserir neste local algum tipo de instrucao "OR" ou "AND", mas ai o filtro nao funciona (todos os valores aparecem independente das escolhas).

O que voce acha?

Private Function PreencheRecordSet(ByVal CodigoRelat As String, ByVal PalavraChave As String) As Recordset
On Error GoTo TrataErro

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sql As String
Dim sqlWhere As String
Dim i As Integer
Dim campo As Field
Dim myArray() As Variant

Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
.Open
End With

sql = "SELECT * FROM [RELATORIO$]"

'monta a cláusula WHERE
Call MontaClausulaWhere(TxtCodigoRelat.Name, "Número", sqlWhere)
Call MontaClausulaWhere(txtPalavraChave.Name, "Palavras-Chave", sqlWhere)

'Listbox 1: EventoGerador
For i = 1 To LstEventoGerador.ListCount
If LstEventoGerador.Selected(i - 1) Then
Debug.Print LstEventoGerador.List(i - 1) & " selecionado"
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " OR"
End If
sqlWhere = sqlWhere & " UCASE(Fonte) LIKE UCASE('%" & Trim(LstEventoGerador.List(i - 1)) & "%')"
End If
Next

'Listbox 2: Elaborador
For i = 1 To LstElaborador.ListCount
If LstElaborador.Selected(i - 1) Then
Debug.Print LstElaborador.List(i - 1) & " selecionado"
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " OR"
End If
sqlWhere = sqlWhere & " UCASE(Responsável) LIKE UCASE('%" & Trim(LstElaborador.List(i - 1)) & "%')"
End If
Next

'faz a união da string SQL com a cláusula WHERE
If sqlWhere <> vbNullString Then
sql = sql & " WHERE " & sqlWhere
End If

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
With rst
.ActiveConnection = conn
.Open sql, conn, adOpenForwardOnly, _
adLockBatchOptimistic
End With

Set rst.ActiveConnection = Nothing

' Fecha a conexão.
conn.Close

Set PreencheRecordSet = rst
Exit Function
TrataErro:
Set rst = Nothing
End Function



Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " AND"
End If
sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & Trim(Me.Controls(NomeControle).Text) & "%')"
End If
End Sub

[webmaster]

Henrique,

Dê um Debug.Print na string sql final para dar uma olhada.

Abraços

[Henrique Miranda]

Tomáz,

Desculpe, eu nunca estudei sobre VBA (to tentando aprender na marra...).

Como eu faço o Debug.Print?

[webmaster]

Exato!

Depois de toda a concatenção com os "WHERE", faça um:

Código: Selecionar todos

Debug.Print sql

E veja o resultado na janela de Verificação Imediata.

Abraços