Friday, May 20, 2011

Google-like Search Box in MS Access

I wanted researchers to be able to search all our finding aids using a simple keyword search. Just searching by basically taking the words entered in the search box and inserting “and” between them would be relatively simple: just parse on the space. It was keeping together words enclosed in quotes that was the challenge. For instance searching for:
ILGWU Local 10
Would return:
ILGWU Local 10 and ILGWU Local 101
But searching for:
ILGWU “Local 10 ”
Will return only”
ILGWU Local 10
I needed to parse the search string on spaces, unless the space was in a phrase enclosed in quotes.

What I ended up doing was iterating through the string, first looking for a quote mark, noting its position, then looking for the next quote mark, noting its position and writing everything between those positions to another variable, and finally deleting that section from the original string. When all the quotes are gone the string is parsed on the spaces and all the parts are reassembled as an SQL search clause.

Here is the code to run the search from text box txtKeyword:

Private Sub txtKeyword_LostFocus()

DoCmd.SetWarnings False

Dim strKeyword As String       'Variable to hold the keywords from txtKeyword on the form.
Dim arrKeyword() As String    'Array to hold the keywords parsed from strKeyword.
Dim strKeyP1 As String          'Variable to hold the parts of strKeyword as it is parsed.
Dim strKeyP2 As String          'Variable to hold the reassembled parts of strKeyword.
Dim i As Integer                      'Counter.
Dim j As Integer                      'Counter.
Dim strSQL As String             'Variable to hold SQL queries.
Dim strWhere As String          'Variable to hold the WHERE clause of the final SELECT query.
Dim strSearch As String          'Variable to hold parts of the WHERe clause as strWhere is assembled.

'Pick up the string of keywords from the text box, txtKeyword, on the form.
strKeyword = Me.txtKeyword
'Debug.Print strKeyword

'Parse the string in strKeyword. The string cannot simply be split on the spaces.
'Words contained in double-quotes must be kept together as a single keyword.
'This routine finds any double-quotes and uses there positions in the string to separate out the keywords.
Do Until Len(strKeyword) = 0
'Test for double-quote mark, chr(34).
     i = InStr(1, strKeyword, Chr(34))
     If i = 1 Then
     'If chr(34) is in the first position test for next chr(34).
          j = InStr(2, strKeyword, Chr(34))
          'Save everything in the quotes to strKeyP1, with wildcards and single qoutes before and after.
          strKeyP1 = "'*" & Mid(strKeyword, i, j) & "*'"
          'Removed the quotes and everything between them from strKeyword.
          strKeyword = Mid(strKeyword, j + 2, Len(strKeyword))
     ElseIf i > 1 Then
     'If there is a qoute, but not in the first position parse the string before it.
     'Test for the first space in the string.
          j = InStr(1, strKeyword, " ")
          If j < i - 1 Then 
          'If j is less than i-1, that is the space comes before the space in front of the qoute 
          'Save everything before the space to strKeyP1, with wildcards and single qoutes before and after. 
               strKeyP1 = "'*" & Left(strKeyword, j - 1) & "*'" 
               'Remove the space and everything before it from strKeyword. 
               strKeyword = Mid(strKeyword, j + 1, Len(strKeyword)) 
           'There is no space before the space in front of the quote 
          'Save everything before the space in front of the quote to strKeyP1, 
          'with wildcards and single qoutes before and after. 
               strKeyP1 = "'*" & Left(strKeyword, i - 2) & "*'" 
               'Remove everything before the quote from strKeyword. 
               strKeyword = Mid(strKeyword, i, Len(strKeyword)) 
          End If 
      'If there is no quote parse the string on the spaces
           i = InStr(1, strKeyword, " ") 
           If i > 0 Then
          'If i is greater than 0 means there is at least one space in the string.
          'Save everything before the space to strKeyP1, with wildcards and single qoutes before and after.
               strKeyP1 = "'*" & Mid(strKeyword, 1, i - 1) & "*'"
               'Remove the space and everything before it from strKeyword.
               strKeyword = Mid(strKeyword, i + 1, Len(strKeyword))
          'If i is 0 there are no spaces in the string.
          'Save strKeyword to strKeyP1, with wildcards and single qoutes before and after.
               strKeyP1 = "'*" & strKeyword & "*'"
               'Set strKeyword to a zero-length string.
               strKeyword = ""
          End If
     End If
          'Debug.Print strKeyP1
          'Debug.Print strKeyword
          'Add strKeyP1 to strKeyP2, delimit with the @ sign. 
          'If users are likely to use @ in the search string choose another delimiter.
               strKeyP2 = strKeyP2 & "@" & strKeyP1
               'The first time strKeyP1 is added to strKeyP2 there will be an 
               'unwanted @ sign at the start of the string.
               If Left(strKeyP2, 1) = "@" Then
               'If @ is in the first position save everything from position 2 to the end to strKeyP2.
                    strKeyP2 = Mid(strKeyP2, 2, Len(strKeyP2))
               'Otherwise save all of the string.
                    strKeyP2 = strKeyP2
               End If
          'Remove any double-quotes from the string.
     strKeyP2 = Replace(strKeyP2, Chr(34), "")
     'Debug.Print "strKeyP2 = " & strKeyP2
     'The above process removes the first keyword from strKeyword.
     'Run the shortened strKeyword through again by looping,
     'when strKeyword becomes a zero-length string the loop will stop.

'Now parse strKeyP2, splitting it on the @ sign and save each part as an element in an array.
arrKeyword() = Split(strKeyP2, "@")

'Cycle through the elements in the array and construct the WHERE clause for the SQL query.
For i = 0 To UBound(arrKeyword)
'For each element add the phrase "[TEXT] Like " in front of it.
strSearch = "[TEXT] LIKE " & arrKeyword(i)
'Debug.Print strSearch
If Len(strWhere) = 0 Then
'If strWhere is a zero-length string no keyword has been added yet.
strWhere = strSearch
'If a keyword has already been added to strWhere add the next keyword,
'separate with the operator "AND".
strWhere = strWhere & " AND " & strSearch
End If
'Debug.Print "strWhere = " & strWhere
Next i

'Construct the final SQL query.
strSQL = "SELECT DISTINCT [Series] FROM qryKeyword WHERE " & strWhere & ";"
'Debug.Print strSQL
'If the keywords entered in the text box, txtKeywords, on the form were:
'ILGWU "Local 10 "
'then strSQL will look like:
'Use strSQL to populate the form's listbox.
Me.lstSearch.RowSource = strSQL

'Turn the warnings back on.
DoCmd.SetWarnings True

End Sub

You’ll note that I am not running the query against a table, that is because the data I want searched is in five fields in two tables. Having a query concatenate the data and then querying the query runs much faster than loading the data into a temporary table first, or trying to do it with one query.

Here is qryKeyword:

SELECT tabNewCollection.CollectionNumber AS Series, tabNewCollection.CollectionTitle & ' ' & tabNewCollection.CollectionCreator & ' ' &
tblFolders.Title & ' ' & tblFolders.ScopeContent &' ' & tblFolders.Date AS [TEXT]
FROM tabNewCollection LEFT JOIN tblFolders ON tabNewCollection.CollectionNumber = tblFolders.Series
WHERE tabNewCollection.CollectionTitle NOT LIKE '*deaccessioned*';

Now all I have to do is get all our folder lists loaded into tblFolders.

No comments:

Post a Comment