A Simple Macro to Track Your Time in the Outlook Calendar
The Scenario
Do you sometimes wonder how time slipped by during the work day, and you can’t recall what projects you worked on or how much time you spent on them? I usually record how I spend my time in the Outlook calendar. For example, today, I did the following:
· I spent one hour discussing article titles with my editor
· I spent two hours meeting with a vendor about the next project
· I spent 1.5 hours blogging.
I created three appointments in my Outlook calendar that represent the time I spent on these tasks*. For convenience, I also record any relevant details of the tasks in the appointment items, which often come in handy when I subsequently try to recall them for status reporting purposes.
(*Note: in this article, a “task” is synonymous with an assignment, and is not referring to the Outlook-specific item type “task”.)
Because it matters to me how much time I spend on writing, working with vendor to acquire content, and blogging, I distinguish them by setting up categories to represent each of these high level projects. The following shows the list of categories I have customized for my purposes in Outlook.
When I create an appointment for a task on the calendar, I specify the appropriate category as well. Using the same three tasks as examples, I specified the yellow "My Writing" category with the discussing article titles task, the green "Acquisition" category with the meeting with vendor task, and the acqua "Community" category with the blogging task.
Note each category is associated with a color, so that at a glance on my calendar, I get an idea what projects I have spent time on today. For appointments that are irrelevant for my time reporting, I don’t associate the appointments with any category.
The Solution
Comes time reporting, I find myself using a calculator to tally time I have spent in the past week on each project. It doesn’t take long for one to wish there is a simple tool to automate the tallying and report on the time spent per project per week. I wrote a macro, FindApptsInTimeFrame, recently using VBA and the Outlook object model to do this. The algorithm is straight-forward enough for any Computer 101 class. There are however a few points of interest and assumptions:
· If you use recurring appointments to track time that is regularly spent on a project, make sure you set the IncludeRecurrences property to True for items in the Calendar folder, and sort the items based on the start of the reporting date range:
'Include all recurring calendar items -
'master appointments as well as recurring appointments.
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
Doing this would include both the master appointments as well as the individual recurring appointments when you subsequently call the Items.Restrict method.
· The purpose of calling Items.Restrict is to apply the date range filtering to obtain all appointments that fall in or overlap with that period. Notice that I mentioned overlap with the reporting period – sometimes you can have tasks that start before the beginning of the reporting period but end within the period, or start after the beginning of the period but also end after the end of the period. You would want to take these appointments into consideration as well, rather than leaving them out altogether. Specify the filter accordingly, as shown below:
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Note also that in such tasks that overlap with the reporting period but do not fall entirely within the reporting period, you would want to include only the amount of time spent on the task within the reporting period, not the portion outside the reporting period.
· The Categories property of an appointment is a string that is delimited by a separator. You can obtain the separator using the following function, WSHListSep, courtesy of Outlook MVP Sue Mosher:
Function WSHListSep()
Dim objWSHShell
Dim strReg
strReg = "HKCU\Control Panel\International\sList"
Set objWSHShell = CreateObject("WScript.Shell")
WSHListSep = objWSHShell.RegRead(strReg)
Set objWSHShell = Nothing
End Function
Having obtained the separator, you can use the VBA Split function to get the categories into an array, strApptCategories, for subsequent manipulation:
strApptCategories = Split(oAppt.Categories, strListSep)
· For a proof of concept, I wrote this in VBA and simplified the input and output enough to support my testing:
· I assumed the default calendar folder contains the appointments I use to track time spent on projects. Alternatively you can use the Folder.EntryID property and NameSpace.GetFolderFromID method to select a specific calendar folder that contains your time-tracking appointments.
· I allocated arrays of size 21 (20 as the upper bound on the array index, since arrays are 0-based) as the maximum number of categories that a user would specify for an appointment.
· I also hard-coded the dates for the reporting period. To specify different dates, you should do that in two places. One place is the following:
'Hard-code the reporting dates just for simplicity in testing.
myStart = DateValue("09/27/2010")
myEnd = DateValue("10/02/2010")
The other is here:
'Reformat myStart and myEnd to account for minutes.
myStart = #9/27/2010 12:01:00 AM#
myEnd = #10/2/2010 12:01:00 AM#
My plan is to add code to support more versatile input and output: allow the user to specify the range of dates and categories of interest to report on (thus determining the maximum number of categories to support for the reporting). For output, there will be additional reporting on the % of time spent on each project.
Alert: If you have appointments in your date range that start and end before the beginning of work hours you have specified in the Outlook Options dialog box, for the purpose of running Items.Restrict for that date range, you should temporarily change the Start time under Work time in the Outlook Options dialog box, so that all appointments end after that Start time value. This is a temporary work around and you can change the Start time back to the desired value after running the macro.
The Macro
The following is the VBA macro. If you plan to run the macro in the Visual Basic Editor, copy the macro from the attached text file instead of this blog post. New lines in the code may be changed by display limitations on this blog site and consequently code copied from the display may not compile properly.
Sub FindApptsInTimeFrame()
Dim myStart, myEnd As Date
Dim oCalendar As Outlook.Folder
Dim oItems As Outlook.Items
Dim oResItems As Outlook.Items
Dim oAppt As Outlook.AppointmentItem
Dim strRestriction As String
Dim strApptCategories
' Set 20 as the number of supported categories, should get that number per user's decision.
Dim strAllCategories(0 To 20) As String
Dim iTotalCount As Integer
Dim iDurationPerCategory(0 To 20) As Integer
Dim strListSep As String
Dim i, j, iNumApptCategories
Dim blnExists As Boolean
Dim dtDiff As Long
'Hard-code the reporting dates just for simplicity in testing.
myStart = DateValue("09/27/2010")
myEnd = DateValue("10/02/2010")
Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set oItems = oCalendar.Items
'Include all recurring calendar items -
'master appointments as well as recurring appointments.
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
'Specify the filter this way to include appointments that overlap
'with the specified date range but do not necessarily fall entirely within
'the date range.
'Date values in filter do not explicitly include minutes.
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Debug.Print strRestriction
'Restrict the Items collection.
Set oResItems = oItems.Restrict(strRestriction)
'Sort
oResItems.Sort "[Start]"
'Reformat myStart and myEnd to account for minutes.
myStart = #9/27/2010 12:01:00 AM#
myEnd = #10/2/2010 12:01:00 AM#
iTotalCount = 0
'Get the separator between categories from the Windows registry.
strListSep = WSHListSep()
For Each oAppt In oResItems
Debug.Print oAppt.Start, oAppt.Subject
Debug.Print oAppt.Duration
' Get the list of categories specified for this appointment.
strApptCategories = Split(oAppt.Categories, strListSep)
iNumApptCategories = UBound(strApptCategories)
' An appointment that doesn't have a category (with iNumApptCategories being 0) skips this loop.
For i = 0 To iNumApptCategories
' Check if category exists in master array strAllCategories.
blnExists = False
If iTotalCount > 0 Then
' Master array already has some categories, see if there's a match or should add category
For j = 0 To iTotalCount - 1
If Trim(strAllCategories(j)) = Trim(strApptCategories(i)) Then
blnExists = True
Exit For
End If
Next
If blnExists = False Then
' First time this category appears, add category to master array and start tallying time.
If iTotalCount >= 20 Then
MsgBox "The maximum number of categories has been reached."
GoTo Dump
End If
iTotalCount = iTotalCount + 1
strAllCategories(iTotalCount - 1) = Trim(strApptCategories(i))
' Check if the appointment is entirely within the date range.
If oAppt.Start >= myStart Then
If oAppt.End <= myEnd Then
iDurationPerCategory(iTotalCount - 1) = oAppt.Duration
Else
dtDiff = DateDiff("n", myEnd, oAppt.End)
iDurationPerCategory(iTotalCount - 1) = oAppt.Duration - dtDiff
End If
Else
dtDiff = DateDiff("n", oAppt.Start, myStart)
iDurationPerCategory(iTotalCount - 1) = oAppt.Duration - dtDiff
End If
Else
' Category already in master array, just tally the time for the category.
' Check if the appointment is entirely within the date range.
If oAppt.Start >= myStart Then
If oAppt.End <= myEnd Then
iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration
Else
dtDiff = DateDiff("n", myEnd, oAppt.End)
iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration - dtDiff
End If
Else
dtDiff = DateDiff("n", oAppt.Start, myStart)
iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration - dtDiff
End If
End If
Else
' First category in master array of categories, start master array and start count of categories.
iTotalCount = 1
strAllCategories(0) = Trim(strApptCategories(i))
' Check if the appointment is entirely within the date range.
If oAppt.Start >= myStart Then
If oAppt.End <= myEnd Then
iDurationPerCategory(0) = oAppt.Duration
Else
dtDiff = DateDiff("n", myEnd, oAppt.End)
iDurationPerCategory(0) = oAppt.Duration - dtDiff
End If
Else
dtDiff = DateDiff("n", oAppt.Start, myStart)
iDurationPerCategory(0) = oAppt.Duration - dtDiff
End If
End If
Next
Next
'List all unique categories and count
Dump:
For j = 0 To iTotalCount - 1
Debug.Print strAllCategories(j), iDurationPerCategory(j)
Next
End Sub
Function WSHListSep()
Dim objWSHShell
Dim strReg
strReg = "HKCU\Control Panel\International\sList"
Set objWSHShell = CreateObject("WScript.Shell")
WSHListSep = objWSHShell.RegRead(strReg)
Set objWSHShell = Nothing
End Function
The Output
For testing purposes, I display the following for each appointment that overlaps or falls within the specified reporting period in the Immediate window of the Visual Basic Editor:
· The date and time of the task
· The description of the task
· The duration spent on the task
At the end, I display the total number of minutes spent on each project in the reporting period.
Trying the Macro
Because this macro may interest Outlook end users as well as developers, if you are not familiar with the Office Visual Basic Editor environment, you can follow these steps to try the macro:
1. Create some appointments that represent time periods that you spent on projects in your calendar.
2. Assign categories to these appointments.
3. Make sure the Developer tab is enabled in the ribbon in Outlook. See How to: Show the Developer Tab on the Ribbon for more information.
4. Click the Developer tab, and click Visual Basic.
5. Double-click the ThisOutlookSession module.
6. Copy the macro from the attached text file to the ThisOutlookSession module in the Visual Basic Editor.
7. Modify the following 2 sets of code statements to specify a date range that includes the appointments you created in step 1, and that you would like to report on:
'Hard-code the reporting dates just for simplicity in testing.
myStart = DateValue("09/27/2010")
myEnd = DateValue("10/02/2010")
And:
'Reformat myStart and myEnd to account for minutes.
myStart = #9/27/2010 12:01:00 AM#
myEnd = #10/2/2010 12:01:00 AM#
8. Click F5 to run the macro.
The primary goal of this macro is to show how to use the Outlook object model to report on appointment times aggregated by category over a specific period of time. I didn’t write this macro to market is as a commercial product. Nonetheless, if you have any suggestions, feel free to leave a comment.
VBA Macro to Print Time Spent Per Category in Date Range.txt
Comments
Anonymous
October 09, 2010
The comment has been removedAnonymous
October 12, 2010
I'll have to explore the different options with VBA. Previously I would just export my calendar items to Excel then do a pivot table to analyze time spent in each category.Anonymous
October 15, 2010
Nice piece of code and very useful. I amended the code to access a colleagues calendar which others might find useful: Set oDummy = Application.CreateItem(olMailItem) Set oRecip = oDummy.Recipients.Add("Joe Bloggs") oRecip.Resolve If oRecip.Resolved Then Set oCalendar = Application.GetNamespace("MAPI").GetSharedDefaultFolder(oRecip, olFolderCalendar) Else Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar) End If