Showing posts with label wildcard. Show all posts
Showing posts with label wildcard. Show all posts

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)) 
          Else: 
           '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 
     Else: 
      '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))
          Else:
          '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))
               Else:
               '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.
Loop

'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
Else:
'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:
'SELECT DISTINCT [Series] FROM qryKeyword WHERE [TEXT] LIKE '*ILGWU*'AND [TEXT] LIKE '*Local 10 *';
'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.

Thursday, March 31, 2011

Getting a Proper Title Sort Order in Microsoft Access

In our publications database I have my student workers enter the titles as they appear, which means that they often have an initial article. Unlike MARC Access does not have a built-in way to tell it to ignore the first four, or whatever, spaces before sorting, so all the titles beginning with “The” are grouped together and all the titles beginning with “An” are grouped together, as so on. I wanted the sort order to ignore any initial articles, since that is the way most users except a list of titles to be constructed. I had thought of adding an “non-indexing spaces” field and using that to control the sort order. This idea was rejected because it meant another data element that the student workers would have to enter, and they would have to think about it not just transcribe what was on the item. Instead, I decided to deal with the initial articles after the fact.

What I did was create a function which strips the initial articles from the titles as the list is being created and the output from the function is used to sort the list even though the full title is displayed. I put this function in a module I call BasicFunctionsRDM, which is where I park any function I might use in other databases, if I need it I just import the entire module into another database. You can place this code in any module you like.

Public Function Article(strTitle As String)
     'Debug.Print "Before: " & strTitle

     'First make sure there are no double spaces after the initial article
     'replace any double spaces with a single space.

     strTitle = Replace(strTitle, Chr(32) & Chr(32), Chr(32))

     'Strip off any initial double quotes

     If Mid(strTitle, 1, 1) Like Chr(34) Then
          strTitle = Mid(strTitle, 2)
     End If

     'Strip the initial article from the title by using the mid-string function.
     'Always include, and count, the space after the article, otherwise you will
     'end up stripping the first two characters from a title beginning "Always".

     If Mid(strTitle, 1, 4) Like "The " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 2) Like "A " Then
          strTitle = Mid(strTitle, 3)
     ElseIf Mid(strTitle, 1, 3) Like "An " Then
          strTitle = Mid(strTitle, 4)
     'Strip off any initial spaces.
     ElseIf Mid(strTitle, 1, 1) Like Chr(32) Then
          strTitle = Mid(strTitle, 2)
     'Strip off any single quotes at the beginning of the title.
     ElseIf Mid(strTitle, 1, 1) Like Chr(33) Then
          strTitle = Mid(strTitle, 2)
     'Strip off any exclamation points at the beginning of the title.
     ElseIf Mid(strTitle, 1, 1) Like Chr(39) Then
          strTitle = Mid(strTitle, 2)
     ElseIf Mid(strTitle, 1, 3) Like "El " Then
          strTitle = Mid(strTitle, 4)
     'Use a single character wildcard to catch both "Le " and "La ".
     ElseIf Mid(strTitle, 1, 3) Like "L? " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "De " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Di " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Il " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Un " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 2) Like "l'" Then
          strTitle = Mid(strTitle, 3)
     'Use a single character wildcard to catch both "Uno " and "Una ".
     ElseIf Mid(strTitle, 1, 4) Like "Un? " Then
          strTitle = Mid(strTitle, 5)
     'Use a single character wildcard to catch "Les ", "Las ", and "Los ".
     ElseIf Mid(strTitle, 1, 4) Like "L?s " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Gli " Then
          strTitle = Mid(strTitle, 5)
     'Use a single character wildcard to catch "Der ", "Dem ", "Den ", and "Des ".
     ElseIf Mid(strTitle, 1, 4) Like "De? " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 6) Like "Einen " Then
          strTitle = Mid(strTitle, 7)
     ElseIf Mid(strTitle, 1, 5) Like "Eine " Then
          strTitle = Mid(strTitle, 6)
     ElseIf Mid(strTitle, 1, 4) Like "Ein " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Die " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Das " Then
          strTitle = Mid(strTitle, 5)
     End If

     'Strip off any double quotes left at the beginning of the title.
     If Mid(strTitle, 1, 1) Like Chr(34) Then
          Article = Mid(strTitle, 2)
     Else:
          Article = strTitle
     End If

     'Debug.Print "After: " & Article

End Function

It’s not perfect. I’m sure I’ve missed some articles in other languages and probably some for the languages I did try to cover, but it is very easy to add another article and this pretty well covers the ones most common in our database.

To use this function simply include it the “Order By” clause of your SQL query. So if you have a text box, txtKeyword, and a search button, cmdSearch, the code in the “On Click” event would look something like this:

Private Sub cmdKeyword_Click()
On Error GoTo Err_cmdKeyword_Click

     Dim strKey As String       'Variable for the keyword.
     Dim strSQL As String      'Variable for the SQL query to populate the results list.

     strKey = Nz(Me!txtKeyword, "")
     strKey = Authority(strKey)
     'Debug.Print strKey
     'Format the keyword with wildcards and single quotes.
     strKey = "'*" & strKey & "*'"
     'Debug.Print "strKey = " & strKey

     'This SQL query pulls the pamphlet ID, title, and date for any pamphlet with
     'the keyword anywhere in the title. It then sorts it by title, ignoring initial articles.

     strSQL = "SELECT tblPams.PamID, tblPams.Title, tblPams.Date FROM tblPams "
     strSQL = strSQL & "WHERE tblPams.Title LIKE " & strKey & " "
     strSQL = strSQL & " ORDER BY Article(tblPams.Title), tblPams.Date;"
     'Debug.Print strSQL

     'Display the search results in a list box.
     Me.lstPamList.RowSource = strSQL
     Forms!frmStartPage.Refresh

     'Display the search query in a text box, txtString, on the form.
     Me!txtString = "Results for Search: Keyword Anywhere LIKE " & strKey & ""

     'Clear the keyword text box.
     Me!txtKeyword = Null

     Exit_cmdKeyword_Click:
          Exit Sub

Err_cmdKeyword_Click:
     MsgBox Err.Description
     Resume Exit_cmdKeyword_Click

End Sub

Tuesday, March 8, 2011

Authority Control. Well, sort of.

In our publications database we have American publications with the word “labor” in the title. We also have British, Canadian, Australian, and other publications with the word “labour” in the title. The problem was if you included “labor” in your title search you did not get titles with “labour” in them. The same held true for “employees” and “employes.” What I needed was for the database to return both when a researcher entered either.

Some if-then-else logic would probably work so that when you search for “Blah Blah Labor Blah” in the title the search is actually for:
(Title = “Blah Blah Labor Blah”) OR (Title = “Blah Blah Labour Blah”)

The solution I came up with is simpler, though not perfect. I run the search string through a function which replaces both “labor” and “labour” with “labo*r”. The wildcard will then match both “labor” and “labour”.

Public Function Authority(strKey1 As String)

      strKey1 = Replace(strKey1, "labor", "labo*r")
      strKey1 = Replace(strKey1, "labour", "labo*r")
      strKey1 = Replace(strKey1, "employee", "employe*")
      strKey1 = Replace(strKey1, "employe", "employe*")
     Authority = strKey1

End Function