Set label colour of another users appointment item.

[Mike R]

Hi,

I want to be able to add/edit appointment items in another users calendar.
This I can do using the GetDefaultSharedFolder method.

I know would like to change the label colour. I found some code on
Slipstick.com , this works fine for my calendar but not for the other
calendars. What do I need to do to make this work:

Thanks in advance

Mike

[snip]

Try

MyCalItem.Save()

Catch

End Try

Call SetApptColorLabel(MyCalItem, 3)

MyCalItem = Nothing



' Code from slipstick site...


Sub SetApptColorLabel(ByVal objAppt As Outlook.AppointmentItem, _
ByVal 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

objCDO = CreateObject("MAPI.Session")
objCDO.Logon("", "", False, False)
If Not objAppt.EntryID = "" Then
objMsg = objCDO.GetMessage(objAppt.EntryID, _
objAppt.Parent.StoreID)
colFields = objMsg.Fields
objField = colFields.Item(CdoAppt_Colors, CdoPropSetID1)
If objField Is Nothing Then
Err.Clear()
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)
Else
Exit Sub
End If
End If

objAppt = Nothing
objMsg = Nothing
colFields = Nothing
objField = Nothing
objCDO.Logoff()
objCDO = Nothing
End Sub