home | get Sue’s code | forums | share code | registration

Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 09-Feb-2010 09:22

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: advanced Code area: Outlook Expert Techniques Printer Friendly Version
Title: Set color label on appointment
Description: The Outlook object model exposes no property for the color label introduced for appointments in Outlook 2002. This label can be read and set, however, using CDO. The code sample demonstrates several useful CDO techniques. One is passing an item from Outlook to CDO using the EntryID and store ID for the item. Also important is that a CDO Field does not exist on the item unless it holds data. Therefore, to set the color label, you may first need to add the field to the item. Update is the CDO method analogous to Save in Outlook objects. Finally, you see how to log on and log off from a CDO session that piggybacks on the current Outlook session. Note that Outlook 2007 does not use color labels. Instead, it colors an item based on the value of the Categories property and the user's master list of categories and their associated colors.
Date: 18-Jul-2003 10:26
Code level: advanced
Code area: Outlook Expert Techniques
Posted by: Sue Mosher
Body: Sub TestColorLabel() Dim objItem As Object Dim thisAppt As AppointmentItem Set objItem = Application.ActiveExplorer.Selection(1) If objItem.Class = olAppointment Then Set thisAppt = objItem Call SetApptColorLabel(thisAppt, 3) End If Set objItem = Nothing Set thisAppt = Nothing End Sub Sub SetApptColorLabel(objAppt As Outlook.AppointmentItem, _ intColor As Integer) ' requires reference to CDO 1.21 Library ' adapted from sample code by Randy Byrne ' intColor corresponds to the ordinal value of the color label '1=Important, 2=Business, etc. Const CdoPropSetID1 = "0220060000000000C000000000000046" Const CdoAppt_Colors = "0x8214" Dim objCDO As MAPI.Session Dim objMsg As MAPI.Message Dim colFields As MAPI.Fields Dim objField As MAPI.Field Dim strMsg As String Dim intAns As Integer On Error Resume Next Set objCDO = CreateObject("MAPI.Session") objCDO.Logon "", "", False, False If Not objAppt.EntryID = "" Then Set objMsg = objCDO.GetMessage(objAppt.EntryID, _ objAppt.Parent.StoreID) Set colFields = objMsg.Fields Set objField = colFields.Item(CdoAppt_Colors, CdoPropSetID1) If objField Is Nothing Then Err.Clear Set objField = colFields.Add(CdoAppt_Colors, vbLong, intColor, CdoPropSetID1) Else objField.Value = intColor End If objMsg.Update True, True Else strMsg = "You must save the appointment before you add a color label. " & _ "Do you want to save the appointment now?" intAns = MsgBox(strMsg, vbYesNo + vbDefaultButton1, "Set Appointment Color Label") If intAns = vbYes Then Call SetApptColorLabel(objAppt, intColor) End If End If Set objMsg = Nothing Set colFields = Nothing Set objField = Nothing objCDO.Logoff Set objCDO = Nothing End Sub
All 122comments

	Page [ 1 2 3 4 5 6 7 8 9 10 Next >> ]
	Sue Mosher 18-Jul-2003 17:34 The reusable heart of the code is the SetApptColorLabel subroutine. The TestColorLabel sub merely demonstrates how to use it by adding a label to a selected appointment.
	Xav 31-Oct-2003 04:38 Sue, very nice code but where can I find the CDO library (it doesn't appears on my reference list) ? Moreover, is there a way to retrieve also the name corresponding to the color ? Many thanks for your help.
	Sue Mosher 31-Oct-2003 06:52 CDO is an optional component that you need to add during Outlook setup. If the user has modified the color labels, there will be a hidden item in the calendar folder containing binary information related to the customizations, but the exact structure of the information is undocumented. You can check it out with Outlook Spy or Mdbvu32.exe.
	Hoan 24-Nov-2003 14:33 Hi Sue, I can see that the appointment has to be created first before setting a label to it. I am using a loop to create a bunch of new appointments. Is there a way to retrieve the newly added appointment's EntryID right after is has been created so that I can use it to set its label? Any help would be great!
	Sue Mosher 24-Nov-2003 16:30 After you save the item, its EntryID will be available.
	Niall Waller 14-Jan-2004 05:28 Hi, Is there any way to customise the text in the labels? You've said that the label text is stored in a hidden binary file in the calendar folder, but i cant find this using Outlook Spy. Its my experience that this is a client setting - since if i change computers i have to resetup my labels. Any info would be halpful...
	Sue Mosher 14-Jan-2004 07:48 I did a little digging and Outlook Spy (IMAPIFolder interface - IMsgStore:Advise() tab notifications) reveals that it's a binary property of the folder, not a hidden item. Property ID is 0x36DC0102. I actually don't think it would be that difficult to figure out the format; it's just not high on my list of priorities.
	steve 21-Apr-2004 15:14 If I display the appointment (i.e. thisAppt.Display) after the call to SetApptColorLabel, then the appointment displays but with the incorrect setting. I've tried all kinds of things (even iterating through the folder list and programmatically opening the appointment) and nothing works. However, if I double click on the item from the Calendar, then it will open. Any ideas on how to get that working? Essentially I want to create an appointment, set the color, and then display the appointment with the label changed so that the user can enter any other data and save the appointment themselves.
	Sue Mosher 22-Apr-2004 07:03 Instead of displaying the original AppointmentItem object that you passed to SetApptColorLabel, try getting a new object using Namespace.GetItemFromID. This code worked for me: Sub TestColorLabel2() Dim objItem As AppointmentItem Dim strEntryID As String Dim strStoreID As String Dim myAppt As AppointmentItem Dim objNS As Outlook.NameSpace Set objItem = Application.CreateItem(olAppointmentItem) objItem.Save strEntryID = objItem.EntryID strStoreID = objItem.Parent.StoreID Call SetApptColorLabel(objItem, 3) Set objItem = Nothing Set objNS = Application.GetNamespace("MAPI") Set myAppt = objNS.GetItemFromID(strEntryID, strStoreID) myAppt.Display Set thisAppt = Nothing End Sub
	Jose Elias 15-May-2004 20:13 Hi Sue, I'm trying to create a code that automates the "color labeling" on appointments created or modified based on the category that they belongs. But I'm having a funny error. When I use this code without the function “mcolCalItems__ItemChange” it works just fine, but when I include this function on the code I cannot create or change any appointment that the Outlook locks in a continuous loop performing disk activities. If I run this code with a breakpoint step by step it works just fine. Any ideas on why this happens and what will be the solution? Very best regards, The code is bellow: ------------------------------------------------------------------------------------------- Dim WithEvents mcolCalItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") Set mcolCalItems = objNS.GetDefaultFolder(olFolderCalendar).Items Set objNS = Nothing End Sub Private Sub mcolCalItems_ItemAdd(ByVal Item As Object) ' #### OPCOES DE MAPEAMENTO DOS LABELS #### ' O numero do label e dado contando de cima para baixo - inicio pelo 1 Dim LabelSelected As Integer Dim ItemCategory As String ItemCategory = Item.Categories If Item.Class = olAppointment Then Select Case ItemCategory Case "Clients" LabelSelected = 1 Case "Firm" LabelSelected = 2 Case "sBiz" LabelSelected = 3 Case "Travel" LabelSelected = 6 Case "Fun" LabelSelected = 7 Case "Birthdays" LabelSelected = 8 Case "MyBizz" LabelSelected = 9 Case Else LabelSelected = 0 End Select Call SetApptColorLabel(Item, LabelSelected) End If End Sub Private Sub mcolCalItems_ItemChange(ByVal Item As Object) ' #### OPCOES DE MAPEAMENTO DOS LABELS #### ' O numero do label e dado contando de cima para baixo - inicio pelo 1 Dim LabelSelected As Integer Dim ItemCategory As String ItemCategory = Item.Categories If Item.Class = olAppointment Then Select Case ItemCategory Case "Clients" LabelSelected = 1 Case "Firm" LabelSelected = 2 Case "sBiz" LabelSelected = 3 Case "Travel" LabelSelected = 6 Case "Fun" LabelSelected = 7 Case "Birthdays" LabelSelected = 8 Case "MyBizz" LabelSelected = 9 Case Else LabelSelected = 0 End Select Call SetApptColorLabel(Item, LabelSelected) End If End Sub Sub SetApptColorLabel(objAppt As Outlook.AppointmentItem, _ intColor As Integer) ---REUSED SetApptColorLabel CODE-----------------------
	Page [ 1 2 3 4 5 6 7 8 9 10 Next >> ]

name email

Search Outlook Code