More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 19-Dec-2014 19:49

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.

Login Password
Remember me
Register | Send my password
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
This message is displayed as VB.NET
 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 125comments
Page [ 1 2 3 4 5 6 7 8 9 10 Next >>  
  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.
  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.
  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.
  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!
  24-Nov-2003  16:30   
After you save the item, its EntryID will be available.
  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...
  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.
  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.
  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
  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 >>