Option Explicit
' VBA Script that gets info on Outlook Tasks using PropertyAccessor and various syntaxes
' (see other scripts at http://www.GregThatcher.com for other ways to get task properties)
' Property Tag Syntax looks like this http://schemas.microsoft.com/mapi/proptag/0x0005000b
' Property Tag Syntax is used for Outlook 'Properties' (defined by Outlook Object Model)
'
' Property ID Syntax looks like this http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f
' Property ID Syntax is used for MAPI Named Properties (optional Outlook properties that can't be deleted) and UserProperties (properties you can add which are visible to the user)
'
' Named Property Syntax looks like this http://schemas.microsoft.com/mapi/string folloowed by a property name
' Named Property Syntax is used to create and view 'Named Properties" (properties you can create, but which are not visible to the user)
'
' Office document syntax looks like this: urn:schemas-microsoft-com:office:outlook#source-table-label
'
' 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
' THIS SCRIPT WILL ONLY RUN ON OUTLOOK 2007 OR LATER (it won't work on Outlook 2003 -- there is no propertyAccessor)
'
' To find the DASL definition of Outlook Properties, use the method described in Professional Outlook 2007 Programming (Programmer to Programmer)
' From the 'Views' menu, create a new view (but don't save it)
' Click on the 'Advanced' tab, and choose 'Filter'
' Choose a Field from the 'Field' dropdown, also choose a condition and value
' Click on the 'Sql tab'
' Check the 'Edit these Criteria' checkbox
'
Public Sub GetTaskInfoUsingPropertyAccessor()
Dim Session As Outlook.NameSpace
Dim Report As String
Dim TaskFolder As Outlook.Folder
Dim currentItem As Object
Dim currentTask As TaskItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim stringArray() As String
Dim index
Dim currentString
Set Session = Application.Session
Set TaskFolder = Session.GetDefaultFolder(olFolderTasks)
For Each currentItem In TaskFolder.Items
If (currentItem.Class = olTask) Then
Set currentTask = currentItem
Set propertyAccessor = currentTask.propertyAccessor
' Report = AddToReportIfNotBlank(Report, "Address Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8074001f")) & vbCrLf
Call AddToReportIfNotBlank(Report, "% Complete", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81020005"))
Call AddToReportIfNotBlank(Report, "Actual Work", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81100003"))
Call AddToReportIfNotBlank(Report, "Assigned", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81290003"))
Call AddToReportIfNotBlank(Report, "Assigned To", propertyAccessor.GetProperty("urn:schemas:httpmail:displayto"))
Call AddToReportIfNotBlank(Report, "Billing Information", propertyAccessor.GetProperty("urn:schemas:contacts:billinginformation"))
stringArray() = propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:office#Keywords")
For index = LBound(stringArray) To UBound(stringArray)
Report = Report & "Categories (" & index & ") " & stringArray(index) & vbCrLf
Next index
' Call AddToReportIfNotBlank(Report, "Company", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8539101f"))
Call AddToReportIfNotBlank(Report, "Complete", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/811c000b"))
' Call AddToReportIfNotBlank(Report, "Contact", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/853a101f"))
Call AddToReportIfNotBlank(Report, "Contacts", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f"))
Call AddToReportIfNotBlank(Report, "Conversation", propertyAccessor.GetProperty("urn:schemas:httpmail:thread-topic"))
Call AddToReportIfNotBlank(Report, "Created", propertyAccessor.GetProperty("urn:schemas:calendar:created"))
Call AddToReportIfNotBlank(Report, "Custom Priority", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8138001f"))
Call AddToReportIfNotBlank(Report, "Custom Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8137001f"))
Call AddToReportIfNotBlank(Report, "Date Completed", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/810f0040"))
Call AddToReportIfNotBlank(Report, "Do Not AutoArchive", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/850e000b"))
Call AddToReportIfNotBlank(Report, "Due Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81050040"))
'Call AddToReportIfNotBlank(Report, "In Folder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0e05001f"))
Call AddToReportIfNotBlank(Report, "Message Class", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x001a001e"))
Call AddToReportIfNotBlank(Report, "Mileage", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/mileage"))
Call AddToReportIfNotBlank(Report, "Modified", propertyAccessor.GetProperty("DAV:getlastmodified"))
' Call AddToReportIfNotBlank(Report, "Notes", propertyAccessor.GetProperty("urn:schemas:httpmail:textdescription"))
' Call AddToReportIfNotBlank(Report, "Outlook Data File", propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:outlook#source-table-label"))
Call AddToReportIfNotBlank(Report, "Outlook Internal Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85520003"))
Call AddToReportIfNotBlank(Report, "Outlook Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8554001f"))
Call AddToReportIfNotBlank(Report, "Owner", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/811f001f"))
Call AddToReportIfNotBlank(Report, "Priority", propertyAccessor.GetProperty("urn:schemas:httpmail:importance"))
Call AddToReportIfNotBlank(Report, "Received Representing Name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0044001f"))
' Call AddToReportIfNotBlank(Report, "Recipient Name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/received_by_name"))
Call AddToReportIfNotBlank(Report, "Recipient No Reassign", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x002b000b"))
Call AddToReportIfNotBlank(Report, "Recipients Allowed", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0002000b"))
Call AddToReportIfNotBlank(Report, "Recurring", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8126000b"))
Call AddToReportIfNotBlank(Report, "Reminder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8503000b"))
Call AddToReportIfNotBlank(Report, "Reminder Override Default", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/851c000b"))
Call AddToReportIfNotBlank(Report, "Reminder Sound", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/851e000b"))
Call AddToReportIfNotBlank(Report, "Reminder Sound File", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/851f001f"))
Call AddToReportIfNotBlank(Report, "Reminder Time", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85020040"))
Call AddToReportIfNotBlank(Report, "Request Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/812a0003"))
Call AddToReportIfNotBlank(Report, "Requested By", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8121001f"))
Call AddToReportIfNotBlank(Report, "Role", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8127001f"))
Call AddToReportIfNotBlank(Report, "Schedule Priority", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/812f001f"))
Call AddToReportIfNotBlank(Report, "Sensitivity", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/sensitivity-long"))
Call AddToReportIfNotBlank(Report, "Start Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81040040"))
Call AddToReportIfNotBlank(Report, "Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81010003"))
Call AddToReportIfNotBlank(Report, "Subject", propertyAccessor.GetProperty("urn:schemas:httpmail:subject"))
Call AddToReportIfNotBlank(Report, "Team Task", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/8103000b"))
Call AddToReportIfNotBlank(Report, "Total Work", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81110003"))
Report = Report & "----------------------------------------------------------------------------------" & vbCrLf & vbCrLf
End If
Next
Call CreateReportAsEmail("List of Tasks and Task properties using various Property Syntaxes", Report)
End Sub
Private Function AddToReportIfNotBlank(Report As String, FieldName As String, FieldValue)
AddToReportIfNotBlank = ""
If (IsNull(FieldValue) Or FieldValue <> "") Then
AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
Report = Report & AddToReportIfNotBlank
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
Set Session = Application.Session
Set Inbox = Session.GetDefaultFolder(olFolderInbox)
Set mail = Inbox.Items.Add("IPM.Mail")
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
|
|