Option Explicit
' VBA Script that gets info on Outlook Contacts using propertyAccessor and various syntaxes
' (see other scripts at http://www.GregThatcher.com for other ways to get contact 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 GetContactInfoUsingpropertyAccessor()
Dim Session As Outlook.NameSpace
Dim Report As String
Dim ContactFolder As Outlook.Folder
Dim currentItem As Object
Dim currentContact As ContactItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim stringArray() As String
Dim index
Dim currentString
Set Session = Application.Session
Set ContactFolder = Session.GetDefaultFolder(olFolderContacts)
For Each currentItem In ContactFolder.Items
If (currentItem.Class = olContact) Then
Set currentContact = currentItem
Set propertyAccessor = currentContact.propertyAccessor
'report = report & AddToReportIfNotBlank("Auto Forwarded", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0005000b")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Account", propertyAccessor.GetProperty("urn:schemas:contacts:account")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Address Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8074001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Address Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80680003")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Anniversary", propertyAccessor.GetProperty("urn:schemas:contacts:weddinganniversary")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Assistant's Name", propertyAccessor.GetProperty("urn:schemas:contacts:secretarycn")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Assitant's Phone", propertyAccessor.GetProperty("urn:schemas:contacts:secretaryphone")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Billing information", propertyAccessor.GetProperty("urn:schemas:contacts:billinginformation")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Birthday", propertyAccessor.GetProperty("urn:schemas:contacts:bday")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business address", propertyAccessor.GetProperty("urn:schemas:contacts:workaddress")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business Address City", propertyAccessor.GetProperty("urn:schemas:contacts:l")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business Address Country/Region", propertyAccessor.GetProperty("urn:schemas:contacts:co")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business Address Post Office Box", propertyAccessor.GetProperty("urn:schemas:contacts:postofficebox")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business address postal code", propertyAccessor.GetProperty("urn:schemas:contacts:postalcode")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business address state", propertyAccessor.GetProperty("urn:schemas:contacts:st")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Business address street", propertyAccessor.GetProperty("urn:schemas:contacts:street")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Business fax number", propertyAccessor.GetProperty("urn:schemas:contacts:facsimiletelephonenumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Business home page", propertyAccessor.GetProperty("urn:schemas:contacts:businesshomepage")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Business telephone number", propertyAccessor.GetProperty("urn:schemas:contacts:officetelephonenumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Business telephone number", propertyAccessor.GetProperty("urn:schemas:contacts:office2telephonenumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Callback phone number", propertyAccessor.GetProperty("urn:schemas:contacts:callbackphone")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Car phone number", propertyAccessor.GetProperty("urn:schemas:contacts:othermobile")) & vbCrLf
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
'Report = Report & AddToReportIfNotBlank("Children", propertyAccessor.GetProperty("urn:schemas:contacts:childrensnames")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("City", propertyAccessor.GetProperty("urn:schemas:contacts:mailingcity")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Company name", propertyAccessor.GetProperty("urn:schemas:contacts:o")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Company main telephone number", propertyAccessor.GetProperty("urn:schemas:contacts:organizationmainphone")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Computer network name", propertyAccessor.GetProperty("urn:schemas:contacts:computernetworkname")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Contacts", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Country/Region", propertyAccessor.GetProperty("urn:schemas:contacts:mailingcountry")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Created", propertyAccessor.GetProperty("urn:schemas:calendar:created")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Customer ID", propertyAccessor.GetProperty("urn:schemas:contacts:customerid")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Department", propertyAccessor.GetProperty("urn:schemas:contacts:department")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 1 address", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8084001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 2 address", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8094001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 3 address", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80a4001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 1 display name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8080001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8009001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80690003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 2 display name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8090001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 3 display name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80a0001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 1 type", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8082001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 2 type", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8092001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("E-mail 3 type", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80a2001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("File As", propertyAccessor.GetProperty("urn:schemas:contacts:fileas")) & vbCrLf
Report = Report & AddToReportIfNotBlank("First name", propertyAccessor.GetProperty("urn:schemas:contacts:givenName")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Flag Completed Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10910040")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Flag Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10900003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Follow Up Flag", propertyAccessor.GetProperty("urn:schemas:httpmail:messageflag")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("FTP site", propertyAccessor.GetProperty("urn:schemas:contacts:ftpsite")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Full name", propertyAccessor.GetProperty("urn:schemas:contacts:cn")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Gender", propertyAccessor.GetProperty("urn:schemas:contacts:gender")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Government ID number", propertyAccessor.GetProperty("urn:schemas:contacts:governmentid")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Hobbies", propertyAccessor.GetProperty("urn:schemas:contacts:hobbies")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Home address", propertyAccessor.GetProperty("urn:schemas:contacts:homepostaladdress")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address city", propertyAccessor.GetProperty("urn:schemas:contacts:homeCity")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address country/region", propertyAccessor.GetProperty("urn:schemas:contacts:homeCountry")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address post office box", propertyAccessor.GetProperty("urn:schemas:contacts:homepostofficebox")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address postal code", propertyAccessor.GetProperty("urn:schemas:contacts:homePostalCode")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address state", propertyAccessor.GetProperty("urn:schemas:contacts:homeState")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home address street", propertyAccessor.GetProperty("urn:schemas:contacts:homeStreet")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home fax", propertyAccessor.GetProperty("urn:schemas:contacts:homefax")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home phone", propertyAccessor.GetProperty("urn:schemas:contacts:homePhone")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Home phone 2", propertyAccessor.GetProperty("urn:schemas:contacts:homephone2")) & vbCrLf
Report = Report & AddToReportIfNotBlank("IM address", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8062001f")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("In Folder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0e05001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Initials", propertyAccessor.GetProperty("urn:schemas:contacts:initials")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Internet free/busy address", propertyAccessor.GetProperty("urn:schemas:calendar:fburl")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("ISDN number", propertyAccessor.GetProperty("urn:schemas:contacts:internationalisdnnumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Job title", propertyAccessor.GetProperty("urn:schemas:contacts:title")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Journal", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8025000b")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Language", propertyAccessor.GetProperty("urn:schemas:contacts:language")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Last name", propertyAccessor.GetProperty("urn:schemas:contacts:sn")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Location", propertyAccessor.GetProperty("urn:schemas:contacts:location")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Mailing Address", propertyAccessor.GetProperty("urn:schemas:contacts:mailingpostaladdress")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Mailing Address Indicator", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8002000b")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Manager's name", propertyAccessor.GetProperty("urn:schemas:contacts:manager")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Message Class", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x001a001e")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Middle name", propertyAccessor.GetProperty("urn:schemas:contacts:middlename")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Mileage", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/mileage")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Mobile phone", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3a1c001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Modified", propertyAccessor.GetProperty("DAV:getlastmodified")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Nickname", propertyAccessor.GetProperty("urn:schemas:contacts:nickname")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Notes", propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:office#Notes")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Office location", propertyAccessor.GetProperty("urn:schemas:contacts:roomnumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Organizational ID number", propertyAccessor.GetProperty("urn:schemas:contacts:employeenumber")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Other address", propertyAccessor.GetProperty("urn:schemas:contacts:otherpostaladdress")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address city", propertyAccessor.GetProperty("urn:schemas:contacts:othercity")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address country/region", propertyAccessor.GetProperty("urn:schemas:contacts:othercountry")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address post office box", propertyAccessor.GetProperty("urn:schemas:contacts:otherpostofficebox")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address postal code", propertyAccessor.GetProperty("urn:schemas:contacts:otherpostalcode")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address state", propertyAccessor.GetProperty("urn:schemas:contacts:otherstate")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other address street", propertyAccessor.GetProperty("urn:schemas:contacts:otherstreet")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other fax number", propertyAccessor.GetProperty("urn:schemas:contacts:otherfax")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Other phone number", propertyAccessor.GetProperty("urn:schemas:contacts:otherTelephone")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Outlook Data File", propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:outlook#source-table-label")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Outlook Internal Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85520003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Outlook Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8554001f")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Pager", propertyAccessor.GetProperty("urn:schemas:contacts:pager")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Personal home page", propertyAccessor.GetProperty("urn:schemas:contacts:personalHomePage")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 1 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8076001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 1 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806a0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 2 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8077001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 2 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806b0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 3 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8078001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 3 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806c0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 4 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/8079001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 4 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806d0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 5 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/807a001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 5 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806e0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 6 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/807b001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 6 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/806f0003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 7 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/807c001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 7 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80700003")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 8 Selected", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/807d001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Phone 8 Selector", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80710003")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("PO Box", propertyAccessor.GetProperty("urn:schemas:contacts:mailingpostofficebox")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Primary phone number", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3a1a001f")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Private", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8506000b")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Profession", propertyAccessor.GetProperty("urn:schemas:contacts:profession")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Radio phone number", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3a1d001f")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Referred by", propertyAccessor.GetProperty("urn:schemas:contacts:referredby")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Reminder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8503000b")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Reminder Time", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85020040")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Reminder Topic", propertyAccessor.GetProperty("urn:schemas:httpmail:messageflag")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Sensitivity", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/sensitivity-long")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Spouse/Partner", propertyAccessor.GetProperty("urn:schemas:contacts:spousecn")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("State", propertyAccessor.GetProperty("urn:schemas:contacts:mailingstate")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Street Address", propertyAccessor.GetProperty("urn:schemas:contacts:mailingstreet")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Subject", propertyAccessor.GetProperty("urn:schemas:httpmail:subject")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Suffix", propertyAccessor.GetProperty("urn:schemas:contacts:namesuffix")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Telex", propertyAccessor.GetProperty("urn:schemas:contacts:telexnumber")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Title", propertyAccessor.GetProperty("urn:schemas:contacts:personaltitle")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("TTY/TDD Phone", propertyAccessor.GetProperty("urn:schemas:contacts:ttytddphone")) & vbCrLf
Report = Report & AddToReportIfNotBlank("User Field 1", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/extensionattribute1")) & vbCrLf
Report = Report & AddToReportIfNotBlank("User Field 2", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/extensionattribute2")) & vbCrLf
Report = Report & AddToReportIfNotBlank("User Field 3", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/extensionattribute3")) & vbCrLf
Report = Report & AddToReportIfNotBlank("User Field 4", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/extensionattribute4")) & vbCrLf
Report = Report & AddToReportIfNotBlank("Web page", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/802b001f")) & vbCrLf
'Report = Report & AddToReportIfNotBlank("Zip/Postal Code", propertyAccessor.GetProperty("urn:schemas:contacts:mailingpostalcode")) & vbCrLf
Report = Report & "----------------------------------------------------------------------------------" & vbCrLf & vbCrLf
End If
Next
Call CreateReportAsEmail("List of Contacts and properties using various Property Syntaxes", Report)
End Sub
Private Function AddToReportIfNotBlank(FieldName As String, FieldValue)
AddToReportIfNotBlank = ""
If (IsNull(FieldValue) Or 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
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
|
|