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

Spell Check MS Access Form Before Updating Table

I got tired of having to spell check after my students entered data into our publications database, so I created a function that spell checks the control values when before the record is saved.

This is the function I added to my BasicFunctions module:

Public Function fnSpellCheck(strTextBox As Control)

     Dim strSpell As String

     'Debug.Print strTextBox

     'This spell check code is from

     'http://www.access-programmers.co.uk/forums/showthread.php?t=130780

     'Posted by forum user "icezebra"

     'Get the value from the text box that is being spell checked.

     strSpell = strTextBox

     'Trying to spell check a null value or zero-length string will result in an error.

     If IsNull(Len(strSpell)) Or Len(strSpell) = 0 Then

     'A null value or zero-length string will skip the spellchecker.

     Else:

     'Define what is to be spell checked.

          With strTextBox

               .SetFocus

               .SelStart = 0

               .SelLength = Len(strSpell)

          End With

          DoCmd.SetWarnings False

          'Run the spellchecker.

          DoCmd.RunCommand acCmdSpelling

          DoCmd.SetWarnings True
          'Note that the line above will turn the warnings back on.

          'If you had the warnings off and want them off comment our or delete the SetWarnings.

     End If

End Function

To use this function I call it in the On Click event of the Save button, before the variables have been assigned values:

     'Running the spell check function on a null or zero-length control value will result in an error.

     If IsNull(me.txtTitle) Then

     'If the value in the control is zero-length the spell checker is skipped.

     Else:

     'Otherwise, the spell checker runs

          Call fnSpellCheck(Forms!frmPamAddition.txtTitle)
     End If
     'Pick up the value for the variable from the form.
     strTitle = me.txtTitle

     If IsNull(me.txtAuthor) Then

     Else:       
          Call fnSpellCheck(Forms!frmPamAddition.txtAuthor)
     End If
     strAuthor = me.txtAuthor

     If IsNull(me.txtOrganization) Then

     Else:         
         Call fnSpellCheck(Forms!frmPamAddition.txtOrganization)

     End If
     strOrganization = me.txtOrganization
     If IsNull(me.txtPublisher) Then

     Else:     
         Call fnSpellCheck(Forms!frmPamAddition.txtPublisher)

     End If
     strPublisher = me.txtPublisher
     If IsNull(me.txtPlaceOfPublication) Then

     Else:        
         Call fnSpellCheck(Forms!frmPamAddition.txtPlaceOfPublication)

     End If
     strPlaceOfPublication = me.txtPlaceOfPublication

     If IsNull(me.txtNote) Then

     Else:

         Call fnSpellCheck(Forms!frmPamAddition.txtNote)

     End If
     strNote = me.txtNote

By listing the controls one after another in this way they will all be spell checked in sequence before the record is saved. After all controls have been checked the rest of the Save button’s On Click event runs.

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.

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

Micosoft Access Front-End Security. Part 3: Authentication at the individual control level.

On some of the forms in our collection management database I have buttons that I want everyone to be able to use, some I only want a few to be able to use, and a few I only want one or two people to be able to use. I control these buttons by using the computer’s user name.

First I added a field called “Level,” to the users table, tblUsers. I used four levels, with level 4 being the administrator level, with no restrictions on what that person can do. Level 1 is the most restricted, users at this level can do little more than search and read data.

In the On Click event of each button that is not a level 1 control I wrap the event procedure in the following If-Then-Else logic:

    Dim intUser As Integer                  ‘This variable holds the number for the user level.

    ‘Pick up the user level by matching the computer’s username with the user ID in tblUsers

    intUser = DLookup("[Level]", "tluUsers", "[UserID] = '" & Environ("username") & "'")

    ‘For a level 2 control you want to allow all level 2, 3, and 4 users, so the code allows

    ‘for users greater than level 1.

    ‘For a level 3 control you want to allow only level 3 and 4 users, so the code allows only

    ‘users greater than level 2.

    ‘A level 4 control has code to allow only users greater than level 3.         

    If intUser > 3 Then

        ‘This is where you would put the code for your event procedure.

    Else:

        MsgBox ("Sorry, you are not authorized to access this procedure.")

    End If

Bound text boxes can be protected by putting this If-Then-Else logic in the Got Focus procedure. If the user level is too low to allow updating the data then reset the focus to another control. In this example level 1 users are not allowed to edit the collection title, but are allowed to edit the donor name.

    If intUser < 2 Then

        MsgBox ("Sorry, you are not authorized to edit the Collection Title")

        Me.DonorsName.SetFocus

    End If

Next Week: Back-End Security.