Creating an Appointment in Outlook 2010 Part II

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
    Me.lbxAppointment.Clear

    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))

            Else

                Me.Duration = 1 'hour

            End If
            If Len(.SubMatches(4)) > 0 Then

                Me.Location = .SubMatches(4)

            End If
        End With
        Me.tbxNarrative.BackColor = vbWhite

    Else

        Me.tbxNarrative.BackColor = vbYellow 'visual indicator that narrative doesn't work

    End If
    'Show the results

    UpdateListbox

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

The time, like 3 or 3:00
Either AM, PM, or an empty string if the user didn’t specify
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.
The subject – text that follows the time and precedes either location or duration
The location – text that follows space+at+space
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 Else dtTime = ConvertStringToTime(sTime, "AM") If dtTime >= TimeSerial(7, 0, 0) And dtTime < TimeSerial(12, 0, 0) Then sReturn = "AM" Else 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)

    Else

        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 tzi As TIME_ZONE_INFORMATION

    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 MGoogleCal.zip