Outlook - Add Color Coding to Calendar Items

The Outlook model doesn't provide access to the Label property, but it can be retrieved/changed via CDO 1.21.
Requires Outlook 2002 or later. Tested with Outlook 2003 only.
Based on http://www.outlookcode.com/codedetail.aspx?id=139

$SAMPLECODE$

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

* FUNCTION SetApptColorLabel
* toAppointment - Appointment object to change label/color for
* tnColor - Label/Color to assign 
LPARAMETERS toAppointment, tnColor 

LOCAL ccCdoPropSetID1, ccCdoAppt_Colors, loCDO, loMsg, loFields, loColorField, oExp AS Exception
ccCdoPropSetID1  = "0220060000000000C000000000000046"
ccCdoAppt_Colors = "0x8214"
ccVbLong         = 3  

ASSERT BETWEEN(tnColor, 0, 9) MESSAGE "Color can be between 0 and 9"

lcCurrFolder = FULLPATH("")
loCDO = CREATEOBJECT("MAPI.Session")
loCDO.Logon("", "", .F., .F.)
SET DEFAULT TO (lcCurrFolder)  

loMsg = loCdo.GetMessage(toAppointment.EntryID, toAppointment.Parent.StoreID)
loFields = loMsg.Fields
TRY
	loColorField = loFields.Item(ccCdoAppt_Colors, ccCdoPropSetID1)
CATCH TO oExp WHEN oExp.ErrorNo = 1429 AND ("MAPI_E_NOT_FOUND" $ oExp.Message)	
	loColorField = loFields.Add(ccCdoAppt_Colors, ccVbLong, tnColor, ccCdoPropSetID1)
ENDTRY
loColorField.Value = tnColor
loMsg.Update(.T., .T.)
loCDO.Logoff()

RETURN  


Comments