VBA Script that gets list of Outlook Tasks using the Outlook Object Model

Option Explicit

' VBA Script that gets list of Outlook Tasks
' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
' Run Outlook, Press Alt+F11 to open VBA
' Programming by Greg Thatcher, http://www.GregThatcher.com
Public Sub GetListOfTasks()
    On Error GoTo On_Error
    
    Dim Session As Outlook.NameSpace
    Dim Report As String
    Dim TaskFolder As Outlook.Folder
    Dim currentItem As Object
    Dim currentTask As TaskItem
    Set Session = Application.Session
    
    Set TaskFolder = Session.GetDefaultFolder(olFolderTasks)
    
    For Each currentItem In TaskFolder.Items
        If (currentItem.Class = olTask) Then
            Set currentTask = currentItem
            
            
            Report = Report & AddToReportIfNotBlank("ConversationTopic", currentTask.ConversationTopic)
            Report = Report & AddToReportIfNotBlank("ActualWork", currentTask.ActualWork)
            Report = Report & AddToReportIfNotBlank("AutoResolvedWinner", currentTask.AutoResolvedWinner)
            Report = Report & AddToReportIfNotBlank("BillingInformation", currentTask.BillingInformation)
            Report = Report & AddToReportIfNotBlank("Body", currentTask.Body)
            Report = Report & AddToReportIfNotBlank("CardData", currentTask.CardData)
            Report = Report & AddToReportIfNotBlank("Categories", currentTask.Categories)
            Report = Report & AddToReportIfNotBlank("Companies", currentTask.Companies)
            Report = Report & AddToReportIfNotBlank("Complete", currentTask.Complete)
            Report = Report & AddToReportIfNotBlank("ContactNames", currentTask.ContactNames)
            Report = Report & AddToReportIfNotBlank("ConversationIndex", currentTask.ConversationIndex)
            Report = Report & AddToReportIfNotBlank("CreationTime", currentTask.CreationTime)
            Report = Report & AddToReportIfNotBlank("DateCompleted", currentTask.DateCompleted)
            Report = Report & AddToReportIfNotBlank("DelegationState", currentTask.DelegationState)
            Report = Report & AddToReportIfNotBlank("Delegator", currentTask.Delegator)
            Report = Report & AddToReportIfNotBlank("DownloadState", currentTask.DownloadState)
            Report = Report & AddToReportIfNotBlank("DueDate", currentTask.DueDate)
            Report = Report & AddToReportIfNotBlank("EntryID", currentTask.EntryID)
            Report = Report & AddToReportIfNotBlank("Importance", currentTask.Importance)
            Report = Report & AddToReportIfNotBlank("InternetCodepage", currentTask.InternetCodepage)
            Report = Report & AddToReportIfNotBlank("IsConflict", currentTask.IsConflict)
            Report = Report & AddToReportIfNotBlank("IsRecurring", currentTask.IsRecurring)
            Report = Report & AddToReportIfNotBlank("LastModificationTime", currentTask.LastModificationTime)
            Report = Report & AddToReportIfNotBlank("MarkForDownload", currentTask.MarkForDownload)
            Report = Report & AddToReportIfNotBlank("MessageClass", currentTask.MessageClass)
            Report = Report & AddToReportIfNotBlank("Mileage", currentTask.Mileage)
            Report = Report & AddToReportIfNotBlank("NoAging", currentTask.NoAging)
            Report = Report & AddToReportIfNotBlank("Ordinal", currentTask.Ordinal)
            Report = Report & AddToReportIfNotBlank("OutlookInternalVersion", currentTask.OutlookInternalVersion)
            Report = Report & AddToReportIfNotBlank("OutlookVersion", currentTask.OutlookVersion)
            Report = Report & AddToReportIfNotBlank("Owner", currentTask.Owner)
            Report = Report & AddToReportIfNotBlank("Ownership", currentTask.Ownership)
            Report = Report & AddToReportIfNotBlank("PercentComplete", currentTask.PercentComplete)
            Report = Report & AddToReportIfNotBlank("ReminderOverrideDefault", currentTask.ReminderOverrideDefault)
            Report = Report & AddToReportIfNotBlank("ReminderPlaySound", currentTask.ReminderPlaySound)
            Report = Report & AddToReportIfNotBlank("ReminderSet", currentTask.ReminderSet)
            Report = Report & AddToReportIfNotBlank("ReminderSoundFile", currentTask.ReminderSoundFile)
            Report = Report & AddToReportIfNotBlank("ReminderTime", currentTask.ReminderTime)
            Report = Report & AddToReportIfNotBlank("ResponseState", currentTask.ResponseState)
            Report = Report & AddToReportIfNotBlank("Role", currentTask.Role)
            Report = Report & AddToReportIfNotBlank("Saved", currentTask.Saved)
            Report = Report & AddToReportIfNotBlank("SchedulePlusPriority", currentTask.SchedulePlusPriority)
            Report = Report & AddToReportIfNotBlank("SendUsingAccount", currentTask.SendUsingAccount)
            Report = Report & AddToReportIfNotBlank("Sensitivity", currentTask.Sensitivity)
            Report = Report & AddToReportIfNotBlank("Size", currentTask.Size)
            Report = Report & AddToReportIfNotBlank("StartDate", currentTask.StartDate)
            Report = Report & AddToReportIfNotBlank("Status", currentTask.Status)
            Report = Report & AddToReportIfNotBlank("StatusOnCompletionRecipients", currentTask.StatusOnCompletionRecipients)
            Report = Report & AddToReportIfNotBlank("StatusUpdateRecipients", currentTask.StatusUpdateRecipients)
            Report = Report & AddToReportIfNotBlank("Subject", currentTask.Subject)
            Report = Report & AddToReportIfNotBlank("TeamTask", currentTask.TeamTask)
            Report = Report & AddToReportIfNotBlank("ToDoTaskOrdinal", currentTask.ToDoTaskOrdinal)
            Report = Report & AddToReportIfNotBlank("TotalWork", currentTask.TotalWork)
            Report = Report & AddToReportIfNotBlank("UnRead", currentTask.UnRead)
            
            Report = Report & vbCrLf & vbCrLf
        End If
        
    Next
    
    
    Call CreateReportAsEmail("List of Tasks", Report)
    
Exiting:
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting
    
End Sub

Private Function AddToReportIfNotBlank(FieldName As String, FieldValue As String)
    AddToReportIfNotBlank = ""
    If (FieldValue <> "") Then
        AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
    End If
    
End Function

' VBA SubRoutine which displays a report inside an email
' Programming by Greg Thatcher, http://www.GregThatcher.com
Public Sub CreateReportAsEmail(Title As String, Report As String)
    On Error GoTo On_Error
    
    Dim Session As Outlook.NameSpace
    Dim mail As MailItem
    Dim MyAddress As AddressEntry
    Dim Inbox As Outlook.Folder
    
    Set Session = Application.Session
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    Set mail = Inbox.Items.Add("IPM.Mail")
    
    Set MyAddress = Session.CurrentUser.AddressEntry
    mail.Recipients.Add (MyAddress.Address)
    mail.Recipients.ResolveAll
    
    mail.Subject = Title
    mail.Body = Report
    
    mail.Save
    mail.Display
    
    
Exiting:
        Set Session = Nothing
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Sub


Problems, Comments, Suggestions? Click here to contact Greg Thatcher
Please read my Disclaimer





Copyright (c) 2013 Thatcher Development Software, LLC. All rights reserved. No claim to original U.S. Gov't works.