Referring to Items in Public (Contacts) Folder
Categories, or any of the keyword type fields are written or read as a
variant array. Here is code that will read the Categories field of a
currently open contact item that has entries in the Categories field.
The open contact should be in the ActiveInspector window:
Private Sub ReadCategories()
Dim oApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim sID As String
Dim oCDO As MAPI.Session
Dim oMsg As MAPI.Message
Dim oFields As MAPI.Fields
Dim oField As MAPI.Field
Dim vCategories As Variant
Dim asCategories() As String
Dim i As Long
Const CdoPropSetID5 = "2903020000000000C000000000000046"
Const CdoContact_Categories = "{" & CdoPropSetID5 _
& "}" & "Keywords"
Set oApp = CreateObject("Outlook.Application")
Set oContact = oApp.ActiveInspector.CurrentItem
sID = oContact.EntryID
Set oCDO = CreateObject("MAPI.Session")
oCDO.Logon "", "", False, False
Set oMsg = oCDO.GetMessage(sID)
Set oFields = oMsg.Fields
Set oField = oFields.Item(CdoContact_Categories)
vCategories = oFields.Item(CdoContact_Categories).Value
i = UBound(vCategories)
ReDim asCategories(i)
For i = LBound(vCategories) To UBound(vCategories)
asCategories(i) = vCategories(i)
Next
oCDO.Logoff
Set oMsg = Nothing
Set oFields = Nothing
Set oField = Nothing
Set oCDO = Nothing
Set oApp = Nothing
Set oContact = Nothing
End Sub
My thanks to Sig Weber of CDOLive for verifying this method of working
with Keywords fields.
--
Ken Slovak
[MVP - Outlook]
Lead Author, Professional Outlook 2000 Programming, Wrox Press
Co-author of "Programming Microsoft Outlook 2000", Chapters 8-13,
Appendices, Sams
Quote:
> You're right, it worked... almost.
> I need the categories in the item, so I tried this:
**********************************************************************
******
Quote:
> ****
> Const CdoContact_Categories =
"{2903020000000000C000000000000046}Keywords"
Quote:
> Const CdoPR_COMPANY_NAME = &H3A16001F
> Set MyMessages = objContactsFolder.Messages
> For Each objContactItem In MyMessages
> Set objFields = objContactItem.Fields
> Set objField1 = Nothing
> Set objField2 = Nothing
> On Error Resume Next
> Set objField1 = objFields.Item(CdoContact_Categories)
> Waarde1 = objField1.Value
> If Waarde1 = Empty Then
> Waarde1 = ""
> End If
> Set objField2 = objFields.Item(CdoPR_COMPANY_NAME)
> Waarde2 = objField2.Value
> MsgBox "Waarde = " + Waarde2 + " " + Waarde1
> Next
> *******************************************************
> No problem for the CompanyName, but the Categoriesfield is always
empty...
> Marc
