You are here: Home > Excel > Export Outlook Tasks to Excel

Export Outlook Tasks to Excel


August 29, 2008 – 12:20 pm by JP

    Here is part of the add-in code that exports Outlook Tasks into Excel. It works the same as the previous code that exports Calendar items, except we set a reference to the default Tasks folder (not Calendar), and I've also incorporated some new code which makes the sub more efficient by writing the data to an array, which is then dumped to the worksheet in one pass.

    Note that the Object Model Guard (OMG) is in play here, depending on the properties you reference. For example, the Body Property of a TaskItem in the code below will trigger the OMG. There are probably other properties that will also trigger the OMG, like trying to access the names or email addresses of anyone associated with the task (Owner, Status update recipients, etc).

    The code below (and the code to export Calendar items) can be ported to Outlook almost as-is, which should avoid the OMG. In fact, I went ahead and did so with the Tasks code, and the Body Property did not trigger the OMG. :)

Excel version:

plain text version
VBA:
  1. Sub GetTasksData(StartDate As Date, Optional EndDate As Date)
  2.  
  3. ' -------------------------------------------------
  4. ' Notes:
  5. ' If Outlook is not open, it still works, but much slower (~8 secs vs. 2 secs w/ Outlook open).
  6. ' End Date is optional, if you want to pull from only one day, use: Call GetTasksData("7/14/2008")
  7. ' -------------------------------------------------
  8.  
  9. Dim olApp As Outlook.Application
  10. Dim olNS As Outlook.Namespace
  11. Dim myTaskItems As Outlook.Items
  12. Dim ItemstoCheck As Outlook.Items
  13. Dim ThisTask As Outlook.TaskItem
  14.  
  15. Dim rng As Excel.Range
  16. Dim rngStart As Excel.Range
  17. Dim rngHeader As Excel.Range
  18. Dim MyBook As Excel.Workbook
  19.  
  20. Dim i As Long
  21. Dim NextRow As Long
  22. Dim ColCount As Long
  23.  
  24. Dim MyItem As Object
  25. Dim StringToCheck As String
  26. Dim arrData() As Variant
  27.  
  28. Application.ScreenUpdating = False
  29.  
  30. ' if no end date is specified, EndDate variable will be "12:00:00 AM"
  31. ' the requestor only wants one day, so set EndDate = StartDate
  32. If EndDate = "12:00:00 AM" Then
  33.     EndDate = StartDate
  34. End If
  35.  
  36. If EndDate <StartDate Then
  37.     MsgBox "Those dates seem switched, please check them and try again.", vbInformation
  38.     GoTo ExitProc
  39. End If
  40.  
  41. If EndDate - StartDate> 28 Then
  42.     ' ask if the requestor wants so much info
  43.     If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then
  44.         GoTo ExitProc
  45.     End If
  46. End If
  47.  
  48. ' get or create Outlook object and make sure it exists before continuing
  49. On Error Resume Next
  50.     Set olApp = GetObject(, "Outlook.Application")
  51.     If Err.Number <> 0 Then
  52.         Set olApp = CreateObject("Outlook.Application")
  53.     End If
  54. On Error GoTo 0
  55. If olApp Is Nothing Then
  56.     MsgBox "Cannot start Outlook.", vbExclamation
  57.     GoTo ExitProc
  58. End If
  59.  
  60. ' hook into default Tasks folder
  61. Set olNS = olApp.GetNamespace("MAPI")
  62. Set myTaskItems = olNS.GetDefaultFolder(olFolderTasks).Items
  63.  
  64. ' ------------------------------------------------------------------
  65. ' the following code adapted from:
  66. ' http://www.outlookcode.com/article.aspx?id=30
  67. ' http://weblogs.asp.net/whaggard/archive/2007/03/21/retrieving-your-
  68. ' outlook-appointments-for-a-given-date-range.aspx
  69. '
  70. With myTaskItems
  71.     .Sort "[StartDate]", False
  72.     .IncludeRecurrences = True
  73. End With
  74. '
  75. StringToCheck = "[StartDate]>= " & Quote(StartDate) & " AND [DueDate] <= " & Quote(EndDate)
  76. Debug.Print StringToCheck
  77. '
  78. Set ItemstoCheck = myTaskItems.Restrict(StringToCheck)
  79. Debug.Print ItemstoCheck.Count
  80. ' ------------------------------------------------------------------
  81.  
  82. If ItemstoCheck.Count> 0 Then
  83.     ' we found at least one task
  84.     ' check to make sure we have actual tasks, not infinite recurrence issues
  85.     If ItemstoCheck.item(1) Is Nothing Then GoTo ExitProc
  86.  
  87.     Set MyBook = Excel.Workbooks.Add
  88.     MyBook.Sheets(1).Name = Format(StartDate, "MMDDYYYY") & " - " & Format(EndDate, "MMDDYYYY")
  89.     Set rngStart = MyBook.Sheets(1).Range("A1")
  90.    
  91.     Set rngHeader = Range(rngStart, rngStart.Offset(0, 3))
  92.    
  93.     ' with assistance from Jon Peltier http://peltiertech.com/WordPress and
  94.     ' http://support.microsoft.com/kb/306022
  95.    
  96.     rngHeader.Value = Array("Subject", "Body", "Start Date", "Due Date")
  97.    
  98.     ColCount = rngHeader.Columns.Count
  99.    
  100.     ' now that we know how many rows and columns we need,
  101.     ' resize the array accordingly
  102.     ReDim arrData(1 To ItemstoCheck.Count, 1 To ColCount)
  103.    
  104.     For i = 1 To ItemstoCheck.Count
  105.    
  106.           Set ThisTask = ItemstoCheck.item(i)
  107.            
  108.             arrData(i, 1) = ThisTask.Subject
  109.             arrData(i, 2) = ThisTask.Body
  110.             arrData(i, 3) = Format(ThisTask.StartDate, "MM/DD/YYYY HH:MM AM/PM")
  111.             arrData(i, 4) = Format(ThisTask.DueDate, "MM/DD/YYYY HH:MM AM/PM")
  112.        
  113.     Next i
  114.    
  115.     rngStart.Offset(1, 0).Resize(ItemstoCheck.Count, ColCount).Value = arrData
  116.  
  117. Else
  118.     MsgBox "There are no tasks during the time you specified. Exiting now.", vbCritical
  119. End If
  120.  
  121. ExitProc:
  122. Set myTaskItems = Nothing
  123. Set olNS = Nothing
  124. Set olApp = Nothing
  125. StringToCheck = vbNullString
  126. Set ItemstoCheck = Nothing
  127. Set MyBook = Nothing
  128. Set rngStart = Nothing
  129. Set rngHeader = Nothing
  130. Set ThisTask = Nothing
  131. Erase arrData
  132. Application.ScreenUpdating = True
  133. End Sub

plain text version
VBA:
  1. Function Quote(MyText)
  2. ' from Sue Mosher's excellent book "Microsoft Outlook Programming"
  3.     Quote = Chr(34) & MyText & Chr(34)
  4. End Function

    Don't forget to include the Quote UDF when copying this code.

    I used an array declared as Variant to store the data returned from Outlook. It's a simple matter to determine the size of the array; since each row represents a separate task, the number of rows is going to be the number of tasks returned by the Restrict Method (ItemstoCheck.Count). The number of columns is even easier; we know how many fields we want to export, so it's just a count of those fields. In the above example, we are exporting four fields, so a count of the number of columns will return the needed value.

    The ReDim statement is used here to re-size the array to make it exactly as large as needed.

    Everything is structured, variable-wise, so that we can easily add or remove columns without needing to re-work large parts of the code. The array size is automatically calculated based on the number of items found and the number of fields we want to export, so if you wanted to export more (or less), simply edit the string values in the Array() Function and add corresponding lines inside the For Loop for arrData to manage.

    To call the code above, simply pass two dates to it, as follows:

plain text version
VBA:
  1. Sub GetTasks()
  2.   Call GetTasksData("8/11/2008", "9/12/2008")
  3. End Sub

    Here is the Outlook version, which is merely a slightly reworked version of the above code. This code also requires the Quote UDF, shown above. The OMG is so heinous that I recommend coding inside Outlook whenever possible, if you need to access anything protected from it (like email addresses). You can always instantiate Excel, Word, or Access from it and do what you need.

Outlook version:

plain text version
VBA:
  1. Sub GetTasksData(StartDate As Date, Optional EndDate As Date)
  2. ' -------------------------------------------------
  3. ' Notes:
  4. ' End Date is optional, if you want to pull from only one day, use: Call GetTasksData("7/14/2008")
  5. ' -------------------------------------------------
  6.  
  7. Dim olApp As Outlook.Application
  8. Dim olNS As Outlook.NameSpace
  9. Dim myTaskItems As Outlook.Items
  10. Dim ItemstoCheck As Outlook.Items
  11. Dim ThisTask As Outlook.TaskItem
  12.  
  13. Dim xlApp As Excel.Application
  14. Dim rng As Excel.Range
  15. Dim rngStart As Excel.Range
  16. Dim rngHeader As Excel.Range
  17. Dim MyBook As Excel.Workbook
  18.  
  19. Dim i As Long
  20. Dim NextRow As Long
  21. Dim ColCount As Long
  22.  
  23. Dim MyItem As Object
  24. Dim StringToCheck As String
  25. Dim arrData() As Variant
  26.  
  27. ' if no end date is specified, EndDate variable will be "12:00:00 AM"
  28. ' the requestor only wants one day, so set EndDate = StartDate
  29. If EndDate = "12:00:00 AM" Then
  30.     EndDate = StartDate
  31. End If
  32.  
  33. If EndDate <StartDate Then
  34.     MsgBox "Those dates seem switched, please check them and try again.", vbInformation
  35.     GoTo ExitProc
  36. End If
  37.  
  38. If EndDate - StartDate> 28 Then
  39.     ' ask if the requestor wants so much info
  40.     If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then
  41.         GoTo ExitProc
  42.     End If
  43. End If
  44.  
  45. Set olApp = Outlook.Application
  46.  
  47. ' hook into default Tasks folder
  48. Set olNS = olApp.GetNamespace("MAPI")
  49. Set myTaskItems = olNS.GetDefaultFolder(olFolderTasks).Items
  50.  
  51. ' ------------------------------------------------------------------
  52. ' the following code adapted from:
  53. ' http://www.outlookcode.com/article.aspx?id=30
  54. ' http://weblogs.asp.net/whaggard/archive/2007/03/21/retrieving-your-
  55. ' outlook-appointments-for-a-given-date-range.aspx
  56. '
  57. With myTaskItems
  58.     .Sort "[StartDate]", False
  59.     .IncludeRecurrences = True
  60. End With
  61. '
  62. StringToCheck = "[StartDate]>= " & Quote(StartDate) & " AND [DueDate] <= " & Quote(EndDate)
  63. Debug.Print StringToCheck
  64. '
  65. Set ItemstoCheck = myTaskItems.Restrict(StringToCheck)
  66. Debug.Print ItemstoCheck.Count
  67. ' ------------------------------------------------------------------
  68.  
  69. If ItemstoCheck.Count> 0 Then
  70.     ' we found at least one task
  71.     ' check to make sure we have actual tasks, not infinite recurrence issues
  72.     If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc
  73.  
  74.     Set xlApp = Excel.Application
  75.    
  76.     xlApp.ScreenUpdating = False
  77.    
  78.     Set MyBook = xlApp.Workbooks.Add
  79.    
  80.     xlApp.Visible = True
  81.    
  82.     MyBook.Sheets(1).Name = Format(StartDate, "MMDDYYYY") & " - " & Format(EndDate, "MMDDYYYY")
  83.     Set rngStart = MyBook.Sheets(1).Range("A1")
  84.    
  85.     Set rngHeader = Range(rngStart, rngStart.Offset(0, 3))
  86.    
  87.     ' with assistance from Jon Peltier http://peltiertech.com/WordPress and
  88.     ' http://support.microsoft.com/kb/306022
  89.    
  90.     rngHeader.Value = Array("Subject", "Body", "Start Date", "Due Date")
  91.    
  92.     ColCount = rngHeader.Columns.Count
  93.    
  94.     ' now that we know how many rows and columns we need,
  95.     ' resize the array accordingly
  96.     ReDim arrData(1 To ItemstoCheck.Count, 1 To ColCount)
  97.    
  98.     For i = 1 To ItemstoCheck.Count
  99.    
  100.           Set ThisTask = ItemstoCheck.Item(i)
  101.            
  102.             arrData(i, 1) = ThisTask.Subject
  103.             arrData(i, 2) = ThisTask.Body
  104.             arrData(i, 3) = Format(ThisTask.StartDate, "MM/DD/YYYY HH:MM AM/PM")
  105.             arrData(i, 4) = Format(ThisTask.DueDate, "MM/DD/YYYY HH:MM AM/PM")
  106.        
  107.     Next i
  108.    
  109.     rngStart.Offset(1, 0).Resize(ItemstoCheck.Count, ColCount).Value = arrData
  110.  
  111.     xlApp.ScreenUpdating = True
  112.  
  113. Else
  114.     MsgBox "There are no tasks during the time you specified. Exiting now.", vbCritical
  115. End If
  116.  
  117.  
  118. ExitProc:
  119. Set myTaskItems = Nothing
  120. Set olNS = Nothing
  121. Set olApp = Nothing
  122. Set xlApp = Nothing
  123. StringToCheck = vbNullString
  124. Set ItemstoCheck = Nothing
  125. Set MyBook = Nothing
  126. Set rngStart = Nothing
  127. Set rngHeader = Nothing
  128. Set ThisTask = Nothing
  129. Erase arrData
  130.  
  131. End Sub

    Note that the code above is early bound and requires a reference to the Excel library. The key changes are: We reference the Outlook Application Object directly, instead of using GetObject or CreateObject. We have to qualify Excel references with the Excel.Application object, xlApp, instead of "Application." Otherwise it's nearly identical, and avoids the OMG considerations.

Enjoy,
JP


Share and Enjoy:
  • StumbleUpon
  • Technorati
  • Digg
  • Google
  • del.icio.us
  • MisterWong

Print This Post Print This Post  |  Email This Post Email This Post  |  Permalink  |  Subscribe to this feed Subscribe now!

Filed Under: Excel, Outlook, VBA, automation
Tags: , , ,

This post has 550 views since August 29, 2008 – 12:20 pm.

Post a Comment

To post VBA code in your comment, use [VBA] tags, like this: [VBA]Code goes here[/VBA].





Subscribe without commenting

Keep Reading:

Browse Posts:


« Conditional Import Text Files || The ultimate in lazy emailing? »