Creating an Appointment in Outlook 2010 Part II

By in Outlook, RegEx on .

Yesterday I posted about replicating how you can enter an item on Google’s calendar in Outlook. Today, we’ll look behind the form to see what’s going on. I won’t cover every piece of code, but you can download the code to see all of it. Let’s start with the Initialize event. In the entry point procedure, I set the When property in certain situations. In the Initialize method, I populate the narrative textbox if When already has a value.

Public Sub Initialize()
    If Me.When <> 0 Then
        Me.tbxNarrative.Text = Format(Me.When, "h:mm am/pm") & Space(1)
    End If
End Sub

If the user has already made some sort of selection on a calendar, this saves having to type it. Changing the narrative textbox also fires an event that is the bulk of the code in the form. Let’s take a look at that now.

Private Sub tbxNarrative_Change()
    Dim rxNarrative As VBScript_RegExp_55.RegExp
    Dim rxMatches As VBScript_RegExp_55.MatchCollection
    Dim dtTimeEntered As Date
    Dim sMeridian As String
    Set rxNarrative = New VBScript_RegExp_55.RegExp
    rxNarrative.Pattern = RegExPattern
    rxNarrative.IgnoreCase = True
    If rxNarrative.test(Me.tbxNarrative.Text) Then
        Set rxMatches = rxNarrative.Execute(Me.tbxNarrative.Text)
        With rxMatches.Item(0) 'there's only one match, all the capture groups are submatches of it
            'Get AM or PM
            sMeridian = GetAMPM(.SubMatches(0), .SubMatches(1))
            dtTimeEntered = ConvertStringToTime(.SubMatches(0), sMeridian)
            'Account for time zones
            Me.When = Me.Day + ConvertTimeToLocal(dtTimeEntered, .SubMatches(2))
            Me.What = .SubMatches(3)
            'Default to 1 hour duration if not entered
            If Len(.SubMatches(5)) > 0 Then
                Me.Duration = Val(.SubMatches(5))
                Me.Duration = 1 'hour
            End If
            If Len(.SubMatches(4)) > 0 Then
                Me.Location = .SubMatches(4)
            End If
        End With
        Me.tbxNarrative.BackColor = vbWhite
        Me.tbxNarrative.BackColor = vbYellow 'visual indicator that narrative doesn't work
    End If
    'Show the results
End Sub

You need to set a reference to the VBScript Regular Expressions 5.5 library. I put the regex pattern in a separate, private function to keep the code tidy. I’ll show that below. If the regex passes, I call Execute to get the matches, then use the Submatches to populate my form’s properties. I get either AM or PM via another function. Then I use that and yet another function to convert the time the user entered into a Date data type. That date gets converted based to the user’s local time. The Duration property is set to 1 hour if the user doesn’t enter a duration. The submatches are in this order

  1. The time, like 3 or 3:00
  2. Either AM, PM, or an empty string if the user didn’t specify
  3. The time zone – EST, EDT, CST, CDT, MST, MDT, PST, PDT, or an empty string if not specified. Definitely could increase these options at some point.
  4. The subject – text that follows the time and precedes either location or duration
  5. The location – text that follows space+at+space
  6. The duration = n.n hour(s) that follows space+for+space

To get AM or PM, I wrote a separate function that takes the time as a string and whatever the user entered for AM or PM if any. If the user entered AM or PM, that’s what’s returned. If not, I assume the time is between 7AM and 6PM.

Private Function GetAMPM(ByVal sTime As String, ByVal sAmpm As String) As String
    Dim sReturn As String
    Dim dtTime As Date
    If Len(sAmpm) > 0 Then
        sReturn = sAmpm
        dtTime = ConvertStringToTime(sTime, "AM")
        If dtTime >= TimeSerial(7, 0, 0) And dtTime < TimeSerial(12, 0, 0) Then
            sReturn = "AM"
            sReturn = "PM"
        End If
    End If
    GetAMPM = sReturn
End Function

This is a little goofy because it checks the time before any time zone shift. I considered applying the time zone shift first, and probably should have, but I didn’t want to rewrite the time zone stuff, so I didn’t. Maybe I’ll fix that in the next version.

The GetAMPM function and the event procedure both use ConvertStringToTime, shown below. It uses the VBA.TimeValue function. TimeValue doesn’t work with a single digit, so I append the “:00” if there’s not already a colon in there. I also tack on the meridian. When I call it from GetAMPM, I always use AM because I don’t know the meridian yet.

Private Function ConvertStringToTime(sTime As String, sMeridian As String) As Date
    If InStr(1, sTime, ":") = 0 Then
        ConvertStringToTime = TimeValue(sTime & ":00" & Space(1) & sMeridian)
        ConvertStringToTime = TimeValue(sTime & Space(1) & sMeridian)
    End If
End Function

Once I have the meridian, I recall ConvertStringToTime with the proper value and store that in dtTimeEntered – this is what the user entered converted to a Date data type. The next step is to account for any time zone information entered by the user. I call ConverTimeToLocal, which uses a Windows API to get the users time zone. I got the time zone API from Chip’s site.

Public Function ConvertTimeToLocal(ByVal dtTime As Date, ByVal sZone As String) As Date
    Dim tz As TIME_ZONE
    Dim lGmtOff As Long
    tz = GetTimeZoneInformation(tzi)
    Select Case sZone
        Case "EDT"
            lGmtOff = -4
        Case "EST", "CDT"
            lGmtOff = -5
        Case "CST", "MDT"
            lGmtOff = -6
        Case "MST", "PDT"
            lGmtOff = -7
        Case "PST"
            lGmtOff = -8
        Case vbNullString
            lGmtOff = -tzi.Bias / 60
    End Select
    ConvertTimeToLocal = dtTime - (TimeSerial(0, tzi.Bias, 0) + TimeSerial(lGmtOff, 0, 0))
End Function

This basically converts the time to GMT, then to the users time. If the user didn’t enter a time zone, Case vbNullString, the Bias (in minutes) is added and subtracted leaving the original time.

Everything else in the event procedure is just jamming submatches into properties. I turn the textbox backcolor yellow if the user enters something that the regex can’t decipher. At the end of the procedure, all those properties I filled are displayed in a listbox with a call to UpdateListBox.

Private Sub UpdateListbox()
    Me.lbxAppointment.AddItem "What: " & Me.What
    Me.lbxAppointment.AddItem "Where: " & Me.Location
    Me.lbxAppointment.AddItem "Starts at: " & Format(Me.When, "m/d/yyyy hh:mm")
    Me.lbxAppointment.AddItem "Ends at: " & Format(Me.EndTime, "m/d/yyyy hh:mm")
End Sub

I created a separate EndTime property that adds the duration to the start time. The duration can be an integer or a decimal and I split that out in a VBA.TimerSerial function. That makes me better than Google.

Public Property Get EndTime() As Date
    EndTime = Me.When + TimeSerial(Int(Me.Duration), (Me.Duration - Int(Me.Duration)) * 60, 0)
End Property

As promised, here’s the function that holds the regex pattern. I split it out into an array so I could hopefully understand it six months from now.

Private Function RegExPattern() As String
    Dim aPattern(1 To 11) As String
    aPattern(1) = "^((?:1[0-2]|0?[1-9])(?::[0-5]\d)?)" 'time
    aPattern(2) = "\s*" 'optional white space
    aPattern(3) = "([ap]m)?" 'optional ampm
    aPattern(4) = "\s*"
    aPattern(5) = "([ECMP][DS]T)?" 'optional time zone
    aPattern(6) = "\s*"
    aPattern(7) = "(.*?" 'what
    aPattern(8) = "(?=\s+for\s+|\s+at\s+|$))" 'look ahead for ' for ' or ' at '
    aPattern(9) = "(?:\s+at\s+(.*?" 'where
    aPattern(10) = "(?=\s+for\s+|$)))?" 'look ahead for ' for '
    aPattern(11) = "(?:\s+for\s+(\d*(?:\.\d+)?)\s*hour)?" 'duration
    RegExPattern = Join(aPattern, vbNullString)
End Function

That’s probably enough code for one post. What you don’t see, but you can download, is the property getters and setters for UserCancel, Location, When, What, Duration, and Day. There’s also code for clicking OK and Cancel, which simply sets the UserCancel property and hides the form.

You can download

Tomorrow I’ll post a couple of notes and some installation instructions if you want to give it a try.

One thought on “Creating an Appointment in Outlook 2010 Part II

Leave a Reply

Your email address will not be published. Required fields are marked *

To create code blocks or other preformatted text, indent by four spaces:

    This will be displayed in a monospaced font. The first four 
    spaces will be stripped off, but all other whitespace
    will be preserved.
    Markdown is turned off in code blocks:
     [This is not a link](

To create not a block, but an inline code span, use backticks:

Here is some inline `code`.

For more help see