none
Restrição de pesquisa RRS feed

  • Pergunta

  • Boa noite.

    Estou com o seguinte problema.

    Gostaria de restringir minha função a pesquisar somente o que esta no txtbox.

    exemplo se eu pesquiso carro 10 e tiver carro 100;1000... ele me mostra todos.

    A

    Private Sub PopulaListBox(ByVal data As String, _
                              ByVal OrdemServico As String, _
                              ByVal Tag As String, _
                              ByVal Area As String, _
                              ByVal Isolacao As String)

        On Error GoTo TrataErro

        Dim rst As ADODB.Recordset
        Dim campo As Field
        Dim myArray() As Variant
        Dim i As Integer

        Set rst = PreecheRecordSet(data, OrdemServico, Tag, Area, Isolacao)
    lstLista.ColumnWidths = "0,9 cm;2,5 cm;2,6 cm ;3 cm ;3 cm; 1,8 cm ; 1,5 cm; 2 cm;3,2 cm; 2,8 cm ; 3 cm; 10 cm"
        'pega o número de registros para atribuí-lo ao listbox
        lstLista.ColumnCount = rst.Fields.Count

        'preenche o combobox com os nomes dos campos
        'persiste o índice
        Dim indiceTemp As Long
        indiceTemp = cboOrdenarPor.ListIndex
        cboOrdenarPor.Clear
        For Each campo In rst.Fields
            cboOrdenarPor.AddItem campo.Name
        Next
        'recupera o índice selecionado
        cboOrdenarPor.ListIndex = indiceTemp

        'coloca as linhas do RecordSet num Array, se houver linhas neste
        If Not rst.EOF And Not rst.BOF Then
            myArray = rst.GetRows
            'troca linhas por colunas no Array
            myArray = Array2DTranspose(myArray)
            'atribui o Array ao listbox
            lstLista.List = myArray
            'adiciona a linha de cabeçalho da coluna
            lstLista.AddItem , 0
            'preenche o cabeçalho
            For i = 0 To rst.Fields.Count - 1
                lstLista.List(0, i) = rst.Fields(i).Name
            Next i
            'seleciona o primeiro item da lista
            lstLista.ListIndex = 0
        Else
            lstLista.Clear
        End If

        'atualiza o label de mensagens
        If lstLista.ListCount <= 0 Then
            lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
        Else
            lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
        End If

        ' Fecha o conjunto de registros.
        Set rst = Nothing
        ' Fecha a conexão.
        'conn.Close

    TrataSaida:
        Exit Sub
    TrataErro:
        Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
        Resume TrataSaida
    End Sub

    Agradeco a ajuda!

    segunda-feira, 10 de junho de 2013 21:42

Respostas

  • Troque

    sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & Trim(Me.Controls(NomeControle).Text) & "%')"

    por

    sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") = UCASE('" & Trim(Me.Controls(NomeControle).Text) & "')"


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 10 de junho de 2013 23:46
    Moderador

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum.

    ---

    Sobre sua pergunta, necessito saber o código que há dentro da função PreecheRecordSet.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 10 de junho de 2013 23:10
    Moderador
  • Desculpe pelo erro, sou novo em perguntas.

    Aqui segue o codigo

    Private Function PreecheRecordSet(ByVal data As String, _
                                      ByVal OrdemServico As String, _
                                      ByVal Tag As String, _
                                      ByVal Area As String, _
                                      ByVal Isolacao 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 sqlOrderBy 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 [Fornecedores$]"
    
        'monta a cláusula WHERE
        'NomeDaEmpresa
        Call MontaClausulaWhere(txtNomeEmpresa.Name, "Data", sqlWhere)
    
        'NomeDoContato
        Call MontaClausulaWhere(txtNomeContato.Name, "OrdemServico", sqlWhere)
    
        'Endereço
        Call MontaClausulaWhere(txtEndereco.Name, "Tag", sqlWhere)
    
        'Cidade
        For i = 1 To lstCidades.ListCount
            'verifica se o item está selecionado
            If lstCidades.Selected(i - 1) Then
                'Monta a cláusula WHERE com OR
                Debug.Print lstCidades.List(i - 1) & " selecionado"
                If sqlWhere <> vbNullString Then
                    sqlWhere = sqlWhere & " OR"
                End If
                sqlWhere = sqlWhere & " UCASE(Cadastro) LIKE UCASE('%" & Trim(lstCidades.List(i - 1)) & "%')"
            End If
        Next
    
        'Telefone
        Call MontaClausulaWhere(txtTelefone.Name, "Area", sqlWhere)
    
        'Região
        Call MontaClausulaWhere(txtRegiao.Name, "Isolacao", sqlWhere)
    
        'faz a união da string SQL com a cláusula WHERE
        If sqlWhere <> vbNullString Then
            SQL = SQL & " WHERE " & sqlWhere
        End If
    
        'faz a união da string SQL com a cláusula ORDER BY
        If cboOrdenarPor.ListIndex <> -1 Then
            sqlOrderBy = " ORDER BY " & cboOrdenarPor.List(cboOrdenarPor.ListIndex, 0)
            'define a direção
            Select Case cboDirecao.ListIndex
            Case Ascendente
                sqlOrderBy = sqlOrderBy & " ASC"
            Case Descendente
                sqlOrderBy = sqlOrderBy & " DESC"
            End Select
            'une a query order ao sql
            SQL = SQL & sqlOrderBy
        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 PreecheRecordSet = rst
        Exit Function
    TrataErro:
        Set rst = Nothing
    End Function


    segunda-feira, 10 de junho de 2013 23:24
  • Experimente trocar a linha

    sqlWhere = sqlWhere & " UCASE(Cadastro) LIKE UCASE('%" & Trim(lstCidades.List(i - 1)) & "%')"

    por

    sqlWhere = sqlWhere & " UCASE(Cadastro) = UCASE('" & Trim(lstCidades.List(i - 1)) & "')"


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 10 de junho de 2013 23:26
    Moderador
  • Benzadeus ainda continua aparecendo todos resultados.
    segunda-feira, 10 de junho de 2013 23:32
  • Por gentileza, poste aqui o código da função MontaClausulaWhere.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 10 de junho de 2013 23:40
    Moderador
  • Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
    'NomeDoContato
        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

    segunda-feira, 10 de junho de 2013 23:43
  • Troque

    sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & Trim(Me.Controls(NomeControle).Text) & "%')"

    por

    sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") = UCASE('" & Trim(Me.Controls(NomeControle).Text) & "')"


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 10 de junho de 2013 23:46
    Moderador
  • Muito Obrigado msmo Benzadeus"!!!!!

    Deu certissimo!!!

    terça-feira, 11 de junho de 2013 00:00