Showing posts with label SQL. Show all posts
Showing posts with label SQL. Show all posts

Tuesday, September 20, 2011

Curly Quotes in MS Access

If you cut and paste text from MS Word, or some other writing application, into MS Access curly quotes, sometimes called smart quotes can be a problem. When you try to run that text through VBA or SQL the quotes can choke your code, especially the single quotes or apostrophes. I have a function to convert single quotes to two single quotes before handling the text in VBA, but it is for straight quotes, Chr(39), and does not recognize the curly quote. To fix this problem I wrote a new function that converts the curly quotes to straight quotes when the text is saved in Access. If you are not using unbound text boxes, you will have to call the function at some other point.

Here is the function:

Public Function fnCurlyQuotes(strText As String)

     'Convert a left single curly quote to a straight single quote
     strText = Replace(strText, Chr(145), Chr(39))
     'Convert a right single curly quote to a straight single quote.
     strText = Replace(strText, Chr(146), Chr(39))
     'Convert a left double curly quote to a straight double quote.
     strText = Replace(strText, Chr(147), Chr(34))
     'Convert a right double curly quote to a straight double quote.
     strText = Replace(strText, Chr(148), Chr(34))

fnCurlyQuotes = strText

End Function

To use the function I simply include it in the On Click event of my form’s Save button:

Private Sub cmdSave_Click()

     Dim intIndex As Integer
     Dim strText As String
     Dim strSQL As String

     intIndex = Me.txtIndex
     'Debug.Print "intIndex = " & intIndex
     strText = Nz(Me. strText, "")
     'Debug.Print "strText = " & strText
     'Convert all double and single curly quotes to straight quotes.
     strText= fnCurlyQuotes(strText)
     'Convert all single quotes to two single quotes.
     strText= fnSingleQuote(strText)

     strSQL = "INSERT INTO tblTable ([Index], [Text]) “
     strSQL = StrSQL & “VALUES (" & intIndex & ", '" & strText & "')"
    
     DoCmd.RunSQL strSQL

End Sub

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.

Friday, April 15, 2011

Single Year and Inclusive Date Range (Year’s Only) Searching in MS Access

In our publications database the dates are enter only as a single four-digit year, or a range of years (two four-digit years separated by a dash). I wanted researchers to get all items that match their date limits, so a simple match on the date field would not work. For example if someone puts 1932 as the date search they should get not only the items with a date of 1932, but also the inclusive dates of 1932-1945 or 1924-1932 or 1910-1950. Conversely, a search for 1961-1970 should return not just 1961-1970, but also 1950-1963 and 1967-1980 and 1965-1966 and 1968. You get the picture.

This actually turns out to be fairly simple, requiring only three clauses in an SQL query.

First the search term needs to be parsed into two separate dates: a start date and an end date.

     strSearchDate = Nz(Me.txtSearch, "")
     strStartDate = Left(strSearchDate,4)
     strEndDate = Right(strSearchDate,4)

Of course, if the search date is a single four-digit year then strStartDate and strEndDate will be the same, but that doesn’t matter.

The first clause pulls any items where if the search date is a single year the item date is an exact match or if the search date is an inclusive date the item date is either a single year or an inclusive date entirely within the search date:

     (LEFT(tblPams.Date,4)>='" & strDateStart & "' AND RIGHT(tblPams.Date,4)<= '" & strDateEnd & "') 

So if someone searches for 1944 this clause would return only 1944, if the search date is 1944-1948 it would return 1945 and 1944-1946 and 1945-1947.

Next we want to find any items where the beginning of an inclusive-date search falls within its inclusive date range:

     '" & strDateStart & "' BETWEEN LEFT(tblPams.Date,4) AND RIGHT(tblPams.Date,4) 

So if the search date is 1922-1933 it will return 1919-1924. Last we want to find any items where the end of the inclusive-date search falls within its inclusive date range:

     '" & strDateEnd & "' BETWEEN LEFT(tblPams.Date,4) AND RIGHT(tblPams.Date,4)

So if the search date is 1922-1933 it will return 1930-1940.

Here is the full VBA code you would need behind a date search button:

Private Sub cmdDateSearch_Click() 
On Error GoTo Err_cmdDateSearch_Click 

     Dim strSearchDate As String      'Variable to hold the search date. 
     Dim strSQL As String                'Variable to hold the SQL query. 
     Dim strDateStart As String         'Variable to hold the start date of the search date. 
     Dim strDateEnd As String          'Variable to hold the end date of the search date. 

     'Get the search date from the form and parse it into the start date and the end date. 
     strSearchDate = Nz(Me!txtDateSearch, "") 
     'Debug.Print strSearchDate 
     strDateStart = Left(strSearchDate, 4) 
     'Debug.Print "Start date = " & strDateStart 
     strDateEnd = Right(strSearchDate, 4) 
     'Debug.Print "End date = " & strDateEnd 

     'This is the SQL query used to populate the results list. 
     strSQL = "SELECT tblPams.PamID, tblPams.Title, tblPams.Date FROM tblPams " 
     strSQL = strSQL & "WHERE ((LEFT(tblPams.Date,4)>='" & strDateStart & "' AND RIGHT(tblPams.Date,4)<= '" & strDateEnd & "') "
     strSQL = strSQL & "OR ('" & strDateStart & "' BETWEEN LEFT(tblPams.Date,4) AND RIGHT(tblPams.Date,4) "
     strSQL = strSQL & "OR '" & strDateEnd & "' BETWEEN LEFT(tblPams.Date,4) AND RIGHT(tblPams.Date,4))) "
     strSQL = strSQL & "ORDER BY Article(tblPams.Title), tblPams.Date;"
     'Debug.Print strSQL
     'Populate the results list and refresh the form.
     Me.lstPamList.RowSource = strSQL
     Forms!frmStartPage.Refresh
     'Clear the search box.
     Me!txtSearchDate = Null

Exit_cmdDateSearch_Click:
Exit Sub

Err_cmdDateSearch_Click:
MsgBox Err.Description
Resume Exit_cmdDateSearch_Click

End Sub

Friday, January 21, 2011

SQL failing in VBA due to apostrophes

The most common reason an SQL statement fails for when I try to run it via VBA, using DoCmd.RunSQL, is that I forget to account of apostrophes or single quotes. This is easly fixed by using the replace() function.

'Pick up the value for your variable.

strSearchTerm = Me.txtSearchBox

'Then run the variable through the replace() function, 
'replacing each single quote with two single quotes.
'This tells the parser to ignore the single quote.

strSearchTerm = Replace(strSearchTerm, " ' ", " ' ' ")

'You can also do this using the ASCII designation for a single quote, chr(39).

strSearchTerm = Replace(strSearchTerm, Chr(39), Chr(39) & Chr(39))