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, August 5, 2011

Sending email from MS Access

When a new accession is added to our collections management database an email is sent to several of the Kheel Center staff. The email includes the new accession’s collection number and title. The VBA code for doing this is triggered when the Save button is clicked on the New Collections form.

One thing you need to do to make this code work is go to Tools in the VBA Editor and under References make sure that the “Microsoft Outlook 12.0 Object Library” is enabled. If Outlook is open on the machine Access will use that account to send the email, if Outlook is not open Access will open Outlook prompt you for your Outlook log in. Note that once you enable the Outlook Object Library the database will no longer work on a machine which does not have Microsoft Outlook installed.

First declare a few variables:

     Dim strCollNum As String           'Variable for the Collection Number.
     Dim strTitle As String                  'Variable for the Collection Title.
     Dim strTo As String                    'Variable for recipients’ email addresses
     Dim appOutLook As Outlook.Application
     Dim MailOutLook As Outlook.MailItem
     Dim NameSpace As NameSpace
     Dim Folder As Folder


I pick up the collection number and title from the New Collections form

    strCollNum = Nz(Me.CollectionNumber, "No Collection Number Assigned")
    strTitle = Me.CollectionTitle
    'List the recipients for the email
    strTo = "FirstRecipient@somewhere.com; SecondRecipient@elsewhere.edu"
 
This is the code that actually sends the email:

     Set appOutLook = CreateObject("Outlook.Application")
     Set NameSpace = appOutLook.GetNamespace("MAPI")
     Set Folder = NameSpace.GetDefaultFolder(olFolderInbox)
     Set MailOutLook = appOutLook.CreateItem(olMailItem)

     With MailOutLook
          .To = strTo
          'Insert the collection number in the subject line.
          .Subject = "New Collection " & strCollNum & " Accessioned"
          'Insert the collection number and title in the body of the message.
           .Body = "I have created a record for " & strCollNum & ": " & strTitle
          'If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
               '.Attachments.Add (Me.Mail_Attachment_Path)
          'End If
          '.DeleteAfterSubmit = True
          .Send
     End With

The commented-out lines of code can be uncommented if you want to include an attachment, which I have not tried and not keep the email in your Sent Items folder.

Friday, July 22, 2011

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.

Friday, July 15, 2011

Changing List Box Results in MS Access

Our publications database currently has about 81,000 items listed in it, mostly union and company grey literature. The database opens to a search form which contains a list box. This used to load with all the items when opened, but once we got past 60,000 it was slow to load. Since there is no need for all items to load I looked for ways to limit the list box results. There is probably a way to load 100 random records, but I wasn’t able to figure one out so instead it started with the first 100 records and each time the database is opened or the form refreshed it opens the next 100 in sequence.

To control where the record set begins I added a new table to the database, tblLoad. There are only two fields and one record in the table. The ID field has a value of 1 and never changes, while the Start field contains the lower limit for the list box record set and is initially had a value of 1 but the value is increased by 99 whenever the search form opens or is refreshed.

Here is the VBA code for the search form’s On Open event:

Private Sub Form_Open(Cancel As Integer)

DoCmd.SetWarnings False

     Dim strSQL As String           'This is the SQL query that provides the record set for the list box.
     Dim lngStart As Long           'This establishes the lower limit of the record set.
     Dim lngEnd As Long            'This establishes the upper limit of the record set.
     Dim lngMax As Long           'This is the ID for the last record in tblPams.

     'Pick up the lower limit from tblLoad.
     lngStart = DLookup("[Start]", "tblLoad", "[ID] = 1")
     'Debug.Print "lngStart = " & lngStart
     'Create the upper limit by adding 99 to the lower limit.
     lngEnd = lngStart + 99
     'Debug.Print "lngEnd = " & lngEnd
     'Pick up the ID for the last record in tblPams.
     lngMax = DMax("[PamID]", "tblPams")
     'Debug.Print "lngMax = " & lngMax
     'To avoid generating a error when the SQL query is run
     'test to make sure that lngEnd is not greater than lngMax.
     If lngEnd > lngMax Then
     'If lngEnd is greater than lngMax reset lngEnd to lngMax.
          lngEnd = lngMax
     Else:
     'Otherwise, keep lngEnd the same.
          lngEnd = lngEnd
     End If

     strSQL = "SELECT tblPams.PamID, tblPams.Title, tblPams.Date FROM tblPams "
     strSQL = strSQL & "WHERE (tblPams.PamID BETWEEN " & lngStart & " AND " & lngEnd & ") "
     strSQL = strSQL & "ORDER BY Article(tblPams.Title), tblPams.Date;"
     'Debug.Print strSQL
     Me.lstPamList.RowSource = strSQL

     'If the last record in the table has been reached we need to reset the lower limit to 1.
     If lngEnd = lngMax Then
          DoCmd.RunSQL "Update tblLoad SET tblLoad.Start = 1 Where tblLoad.ID = 1"
     Else:
     'Otherwise, the current upper limit becomes the next lower limit.
          DoCmd.RunSQL "UPDATE tblLoad SET tblLoad.Start = " & lngEnd & " Where tblLoad.ID = 1"
     End If

DoCmd.SetWarnings True

End Sub

Thursday, July 7, 2011

Next and Previous Buttons on a MS Access Form

Since I generally use unbound controls on my forms when a record is selected from a listbox the built-in navigation buttons do not work, the form only sees one record. In order to allow users to navigate back and forth through the list in the listbox I needed to create my own navigation buttons.

The key to creating Next Record and Previous Record buttons is to have a public variable to hold the list index value.

     Option Compare Database
     Public intIndex As Integer

This variable is initially populated in the form’s On Load event.

     intIndex = Forms!frmFolderItemList.lstItems.ListIndex

The On Click event for the Next Record button takes intIndex, adds 1 to it and moves the focus of the listbox to that List Index value. Then the On Load event is called.

     Private Sub cmdNext_Click()

         'Debug.Print "intIndex = " & intIndex
         intIndex = intIndex + 1
          'Debug.Print "intIndex_Next = " & intIndex
          Forms!frmFolderItemList.lstItems.ListIndex = intIndex
         Call Form_Load

     End Sub

The On Click event for the Previous Record button subtracts 1.

     Private Sub cmdPrevious_Click()

         'Debug.Print "intIndex = " & intIndex
         intIndex = intIndex - 1
         'Debug.Print "intIndex_Next = " & intIndex
          Forms!frmFolderItemList.lstItems.ListIndex = intIndex
          Call Form_Load

     End Sub

This works very well, except when the user tries to click the Next Record button when the last record is already being displayed, or the Previous Record button when the first record is being displayed. To fix this the Previous Record button needs to be hidden when the listbox focus is on the first record, and the Next Record button needs to be hidden when the focus is on the last record. You can determine where the focus is in the list by comparing the List Index to the List Row Count.

Dimension a variable for the List Row Count in the On Load event for the form and populate it.

     Dim intRowCount As Integer

     intRowCount = Forms!frmFolderItemList.lstItems.ListCount

The variable for the List Index, intIndex, is a public variable that was populated earlier in the On Load event in order to be available for the On Click events of the Next Record and Previous Record buttons. The variable is simply reused here.

     'You cannot hide a control that has focus, so make sure the focus goes to some
     'control other than the Next Record or Previous Record buttons.
     Me.txtDescription.SetFocus

     If intRowCount > 1 Then
     'For a list with at least two items the Next button will be used
     'as long as you are not already at the last item.
          If intIndex = intRowCount - 2 Then
          'The List Index starts at 0 and the Row Count starts at 1 and counts the column heads.
          'If you are using the column heads you need to subtract 2 from the Row Count in order
          'to identify the last item in the list and hide the Next button.
          'If you are not using the column heads you need to subtract only 1.
               cmdNext.Visible = False
          Else:
               cmdNext.Visible = True
          End If
     Else:
     'When there is only one item in the list the Next button is not used.
          cmdNext.Visible = False
     End If

     If intRowCount > 1 Then
     'For a list with at least two items the Previous button will be used
     'as long as you are not already at the first item.
          If intIndex = 0 Then
          'The first item in the list will always have a List Index value of 0,
          'so if that is true hide the Previous button.
               cmdPrevious.Visible = False
          Else:
               cmdPrevious.Visible = True
          End If
     Else:
     'When there is only one item in the list the Previous button is not used.
          cmdPrevious.Visible = False
     End If

Friday, June 3, 2011

Validating a Year Field in MS Access

For my folder list database, which is where students enter basic folder level data for our finding aids, I only want a four-digit year or two four-digit years separated by a dash in the data field. The reason for this is that programming that runs against the folder list later relies on that format for the date. I have been having a problem with students remembering this and decided to force them to comply via programming in the database.

My first thought was to create a validation rule for the field in the table, which would be:

Like “####” Or Like “####-####”

But I wanted to stop the OnClick event and return the user to the date field on the form while being certain that nothing was saved to the table (I use unbound controls on my forms).

Adding the validation rule to the date text box would accomplish this, but I need to add “Is Null” to the rule or Access would not allow a folder with no date, of which we have many:

Like "####" Or Like "####-####" Or Is Null

The one thing I did not like about this was that if the date in the text box was invalid you could not use any of the other controls on the form until you fixed the date. I can see wanting to use the “Close” or “Clear” buttons. So what I opted to do was put the validation in the VBA for the OnClick event behind the Save button.

Here is the code I inserted right after the value from the Date textbox is picked up:

     If strDate Like "####" Then
          'The date is a four-digit year,
          'continue with the OnClick event.
     ElseIf strDate Like "####-####" Then
          'The date is two four-digit years separated by a dash,
          'continue with the OnClick event.
     ElseIf strDate Like "" Then
          'No date, which I consider okay,
          'continue with the Onclick event.
     Else:
          MsgBox ("Please enter a 4-digit year or two 4-digit years separated by a dash")
          'The date is invalid, set focus to the date field and stop the OnClick event.
          Me.txtDate.SetFocus
          Exit Sub
     End If

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.