Поделиться через


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 removed

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