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
Tomorrow I'll post a couple of notes and some installation instructions if you want to give it a try.
