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

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

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

One Comment

  1. David Hager says:

    I wish that I had enough time to work on stuff like this in my job. Thanks for sharing.

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: