'Globals
Dim oOutlook
Dim oNamespace
Dim oFolder
Dim aItems
Dim oTask
Dim szBuffer
Dim aPriority 
Dim aStatus
Dim aPriorityColors
Dim aStatusColors

aPriority = Array("Low", "Medium", "High")
aStatus = Array("Not Started", "In Progress", "Completed", "Waiting on someone else", "Deferred")
aPriorityColors = Array("none", "yellow", "red")
aStatusColors = Array("red", "green", "green", "yellow", "blue")

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


'Create Outlook, Namespace, Folder Objects and Task Item
Set oOutlook = CreateObject("Outlook.application")
Set oNamespace = oOutlook.GetNameSpace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderTasks)
Set aItems = oFolder.Items

szBuffer = "<table border=""1"" style=""font-family: Calibri"">" & vbCrLf &"<tr><th>Project</th><th>Task</th><th>Priority</th><th>Status</th><th>Due Date</th><th>Status</th><th>Notes</th></tr>" & vbCrLf 

'Build Table
nCount = 0
For Each oTask in aItems
  'oTask has the following properties - http://msdn2.microsoft.com/en-us/library/aa211067(office.11).aspx
  If oTask.Sensitivity=0 Then 'only non-private tasks
    szBuffer = szBuffer & "<tr>"
    szBuffer = szBuffer & "<td>" & oTask.BillingInformation & "</td>"
    szBuffer = szBuffer & "<td>" & oTask.Subject & "</td>"
    szBuffer = szBuffer & "<td>" & aPriority(oTask.Importance) & "</td>"
    szBuffer = szBuffer & "<td style=""background-color: " & aStatusColors(oTask.Status) &  """>" & aStatus(oTask.Status) & "</td>"
    if oTask.DueDate = "1/1/4501" Then 'Outlook stupidity
      szBuffer = szBuffer & "<td>None</td>" 
    else
      szBuffer = szBuffer & "<td>" & oTask.DueDate & "</td>"
    end if
    szBuffer = szBuffer & "<td>" & oTask.PercentComplete & "</td>"
    szBuffer = szBuffer & "<td>" & oTask.Body & "</td>"
    szBuffer = szBuffer & "</tr>"
  End If
Next

Set oMsg =  oOutlook.CreateItem(olMailItem)
oMsg.To = "Big Brother" 
oMsg.Subject = "Status Report - " & Date()
oMsg.Display
szBuffer = replace(szBuffer,vbCrLF,"<br>")
oMsg.HTMLBody = szBuffer

'Clean up
Set oFolder = Nothing
Set oNamespace = Nothing
set oOutlook = Nothing
set oMsg = Nothing