VBA Script that gets list of Outlook Contacts using the Property Accessor


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


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.