Automate a status report from Outlook tasks (vbscript)

[John McGee via OfficeKB.com]

Hello:

I am trying to automate a status report from Outlook tasks for my team. I
have a few questions:

1. The task folders reside in our teams mailbox. How do I attach to a
different mailbox in my script?

2. The script below only counts tasks in the root of the tasks folder.
How do I count subfolders of the tasks folder? I have 17 subfolders I
need to loop through.

Thanks for a great site and any help you may be able to offer.
John McGee

Credit to Bruce Szabo for the original code.
http://www.serverwatch.com/tutorials/article.php/1475621
----------------------------------------------------------------------------
---------


Dim objOutlook
Dim objNameSpace
Dim objFolder
Dim MyItems
Dim CurrentTask
Dim strOutput

Const olMailItem = 0
Const olTaskItem = 3
Const olFolderTasks = 13


'Create Outlook, Namespace, Folder Objects and Task Item
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderTasks)
Set MyItems = objFolder.Items
dtLastWeek = DateAdd("d", -7, date)
dtNextWeek = DateAdd("d", +7, date)
'Loop through all tasks with a Due Date on or before Today.
strOutput = strOutput & "<h2>Due This Week</h2>"
icount = 0
For Each CurrentTask in MyItems
If currentTask.DueDate >= dtLastWeek And
CurrentTask.DueDate <= Date Then
icount = icount + 1
strOutput = strOutput & icount & ". " &
CurrentTask.Subject
if CurrentTask.Complete then
strOutput = strOutput & "-<b> COMPLETED</b>-" &
vbCrLf
else
strOutput = strOutput & vbCrLf
end if
if len(currentTask.Body) > 0 then
strOutput = strOutput & "<blockquote><b>Notes: </b>"
& CurrentTask.body & "</blockquote>" & vbCrLF & vbCrLF
else
strOutput = strOutput & vbCrLf
end if
End If
Next

strOutput = strOutput & "<h2>Due Next Week</h2>"
icount = 0
For Each CurrentTask in MyItems
If currentTask.DueDate > date And CurrentTask.DueDate <=
dtNextWeek Then
icount = icount + 1
strOutput = strOutput & icount & ". " &
CurrentTask.Subject
if CurrentTask.Complete then
strOutput = strOutput & "-<b> COMPLETED</b>-" &
vbCrLf
else
strOutput = strOutput & vbCrLf
end if
if len(currentTask.Body) > 0 then
strOutput = strOutput & "<blockquote><b>Notes: </b>"
& CurrentTask.body & "</blockquote>" & vbCrLF & vbCrLF
else
strOutput = strOutput & vbCrLf
end if
End If
Next

strOutput = strOutput & "<h2>Future Tasks</h2>"
icount = 0
For Each CurrentTask in MyItems
If currentTask.DueDate >= dtNextWeek Then
icount = icount + 1
strOutput = strOutput & icount & ". " &
CurrentTask.Subject
strOutput = strOutput & " Due -<b> " &
currentTask.DueDate & "</b>" & vbCrLf
if len(currentTask.Body) > 0 then
strOutput = strOutput & "<blockquote><b>Notes: </b>"
& CurrentTask.body & "</blockquote>" & vbCrLF & vbCrLF
else
strOutput = strOutput & vbCrLf
end if
End If
Next

' create new outgoing message

Set objMsg = objOutlook.CreateItem(olMailItem)

objMsg.To = "(e-mail address removed)" ' your reminder
notification address
objMsg.Subject = "Status Report - " & Date()
objMsg.Display
strOutput = replace(strOutput,vbCrLF,"<br>")
objMsg.HTMLBody = strOutput

'Clean up
Set objFolder = Nothing
Set objNameSpace = Nothing
set objOutlook = Nothing

set objMsg = Nothing