Using keywords to find records and list them in a

2019-08-20 07:41发布

问题:


I have a form (frmSearch) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere which is a list of columns from tblContacts (the table qryContactWants uses)



I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.


This function organizes the keywords:

Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean
Dim var
Dim aWords
    aWords = Split(strWordList, ",")

    For Each var In aWords
        If FindWord(varFindIn, var) Then
            FindAnyWord = True
            Exit Function
        End If
    Next var          
End Function


And this function actually performs the search:

    Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean

   Const PUNCLIST = """' .,?!:;(){}[]-—/"
   Dim intPos As Integer

   FindWord = False

   If Not IsNull(varFindIn) And Not IsNull(varWord) Then
       intPos = InStr(varFindIn, varWord)

       ' loop until no instances of sought substring found
       Do While intPos > 0
           ' is it at start of string
           If intPos = 1 Then
               ' is it whole string?
               If Len(varFindIn) = Len(varWord) Then
                   FindWord = True
                   Exit Function
               ' is it followed by a space or punctuation mark?
               ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                   FindWord = True
                   Exit Function
               End If
           Else
               ' is it precedeed by a space or punctuation mark?
               If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
                   ' is it at end of string or followed by a space or punctuation mark?
                   If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                       FindWord = True
                       Exit Function
                   End If
               End If
           End If

           ' remove characters up to end of first instance
           ' of sought substring before looping
           varFindIn = Mid(varFindIn, intPos + 1)
           intPos = InStr(varFindIn, varWord)
       Loop
   End If

End Function


And here is the code that I typically use to filter the listbox using the comboboxes on frmSearch:

   Dim column As String

   SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
    & "FROM qryContactWants " _
    & "WHERE 1=1 "
    If cboType.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
    End If
    If cboMake.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
    End If
    If cboModel.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
    End If
    If cboYear.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
    End If
    If cboCondition.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
    End If

    SQL = SQL & " ORDER BY qryContactWants.Last"

    Me.lstCustomers.RowSource = SQL
    Me.lstCustomers.Requery
End Sub



What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers

Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING

EDIT 1:

While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:

Public Function KeyWhere(strKeys As String, strColumn As String) As String

  Dim b As Variant
  strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns

  b = Split(strKeys, ",")
  Dim strWhere   As String
  Dim v As Variant
  For Each v In b
     If Trim(b) <> "" Then
        If strWhere <> "" Then strWhere = strWhere & " or "
         strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
        End If
     End If
  Next
  strWhere = "(" & strWhere & ")"
  KeyWhere = strWhere

End Function

And under the function RequerylistCustomers() I added the If IsNull (Me.txtSearch) = False Then code below:

Private Sub RequerylstCustomers()
   Dim SQL As String
   'Dim criteria As String
   Dim column As String

   SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
    & "FROM qryContactWants " _
    & "WHERE 1=1 "
    If cboType.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
    End If
    If cboMake.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
    End If
    If cboModel.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
    End If
    If cboYear.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
    End If
    If cboCondition.Value & "" <> "" Then
        SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
    End If

    Dim strWhere   As String
    'Grab Keywords from txtSearch using cboWhere to search for those keywords
    If IsNull(Me.txtSearch) = False Then
        strWhere = KeyWhere(Me.txtSearch, Me.cboWhere)
        SQL = SQL & " AND " & strWhere
    End If

    SQL = SQL & " ORDER BY qryContactWants.Last"


    Me.lstCustomers.RowSource = SQL
    Me.lstCustomers.Requery
End Sub

回答1:

Are the keywords to be searched in a single column (say a comments or memo column?). If yes, then you should be able to optional "add" the one additional criteria to your current "set" of combo box filters.

Are we to assume that the keywords can appear anywhere in that memo column to search?

So, if there are "key words entered into that text box, then you call KeyWhere.

eg this routine:

Public Function KeyWhere(strKeys As String, strColumn As String) As String


  Dim b    As Variant
  strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns

  b = Split(strKeys, ",")
  Dim strWhere   As String
  Dim v    As Variant
  For Each v In b
     if trim(v) <> "" then
        If strWhere <> "" Then strWhere = strWhere & " or "
        strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
     end if
  Next
  strWhere = "(" & strWhere & ")"
  KeyWhere = strWhere

End Function

We assume each key word is separated by a comma (could be space, but comma is better).

So, if I type in the following command in debug window to test the above?

?  keywhere("Generator, Water maker, Battery","Notes")

OutPut:

(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')

So, we just append the above results to your final SQL.

eg:

dim strWhere   as string
if isnull(me.KeyWordBox) = False then
  strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
  SQL = SQL & " AND " & strWhere
end if

so, the above converts all keywords into a valid SQL condition for the column to search. It is likely that column is some kind of notes column, but it would work for other description type field to search.