Labelcolor

  • Thread starter Thread starter Hans-Christian Francke
  • Start date Start date
H

Hans-Christian Francke

I searched everywhere trying to find the property for the labelcolor for an
AppointmentItem but could find it. How do I read/set this property using
VBA. Thanks for any hints.

Kind regards
Hans-Christian Francke
 
I see that this returns the index, but I am looking for the color code
itself. Any idea how to grab the RGB value or Colorvalue.


"Sue Mosher [MVP]" <[email protected]> skrev i melding
You need to use CDO, not Outlook objects. See
http://www.slipstick.com/calendar/colorcal.htm#notes
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
The colors are hard-coded into Outlook and cannot be changed. And since they're hardcoded, there's no interface to read them programmatically except at the Windows level. (I'd just grab a screen shot and point my graphics tool to it to find out the RGB value for each label.)
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
Thanks, that worked well. Hardcoding works fine :)

"Sue Mosher [MVP]" <[email protected]> skrev i melding
The colors are hard-coded into Outlook and cannot be changed. And since
they're hardcoded, there's no interface to read them programmatically except
at the Windows level. (I'd just grab a screen shot and point my graphics
tool to it to find out the RGB value for each label.)
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
One exception though - it seems not to work with recurring appointments???
Do you have any idea about this?

"Sue Mosher [MVP]" <[email protected]> skrev i melding
The colors are hard-coded into Outlook and cannot be changed. And since
they're hardcoded, there's no interface to read them programmatically except
at the Windows level. (I'd just grab a screen shot and point my graphics
tool to it to find out the RGB value for each label.)
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
What specifically doesn't work? I use labels on recurring appointments all the time.

--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
I use the below code to find the colorcode, but the objMsg Is Nothing when
AppointmentItem is recurring:

Set objMsg = objCDO.GetMessage(myCalItem.EntryID,
myCalItem.Parent.StoreID)
Set colFields = objMsg.Fields
Set objField = colFields.Item(CdoAppt_Colors, CdoPropSetID1)
With objField
Select Case .Value
Case 0
Case 1
NodXI.BackColor = RGB(255, 180, 180)
Case 2
NodXI.BackColor = RGB(145, 145, 255)
Case 3
NodXI.BackColor = RGB(170, 255, 170)
Case 4
NodXI.BackColor = RGB(192, 192, 192)
Case 5
NodXI.BackColor = RGB(255, 182, 108)
Case 6
NodXI.BackColor = RGB(128, 255, 255)
Case 7
NodXI.BackColor = RGB(177, 177, 101)
Case 8
NodXI.BackColor = RGB(255, 220, 220)
Case 9
NodXI.BackColor = RGB(0, 166, 166)
Case 10
NodXI.BackColor = RGB(255, 255, 155)
End Select
End With

"Sue Mosher [MVP]" <[email protected]> skrev i melding
What specifically doesn't work? I use labels on recurring appointments all
the time.

--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
Where does myCalItem come from? Is it a master AppointmentItem or an individual recurrence?

--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
myCalItem refer to a specific AppointmentItem within a For Next loop.

For Each myCalItem In myRestrictItems
'then the code in here
Next

"Sue Mosher [MVP]" <[email protected]> skrev i melding
Where does myCalItem come from? Is it a master AppointmentItem or an
individual recurrence?

--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
How did you instantiate myRestrictItems? With or without Sort and IncludeRecurrences? It's awfully hard to try to duplicate an issue without even knowing whether you're getting master AppointmentItem objects or individual recurrences.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
OK, here we go - below you'll find the entire sub:

Sub showCalItems(StartDate As Date, EndDate As Date)
On Error Resume Next
Dim myRestrictItems As Items, strTxt As String
Dim myCalItem As AppointmentItem, NodesCal As Nodes, nodX As Node
Dim NodXI As Node, itemStart As Date, itemEnd As Date, lDate As Date
Dim objCDO As Object, intIcon As Integer, intDayIcon As Integer
Dim strIncr As String, I As Integer
Dim intWeek As Integer, objRecurPattern As RecurrencePattern
Dim strTempArrayText As String

Const omHourAndMinute As String = "hh:nn"
Const omNullHour As String = "00:00"
Const omDayEnd As String = "ddddd 23:59"
Const omFullMoon As String = "fullMoon"
Const omNewMoon As String = "newMoon"
Const CdoPropSetID1 = "0220060000000000C000000000000046"
Const CdoAppt_Colors = "0x8214"
Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon "", "", False, False
With
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
.Sort "[Start]"
.IncludeRecurrences = True
Set myRestrictItems = .Restrict("[Start] >= '" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' And [Start] <='" &
_
Format$(EndDate, "mmm-dd-yyyy 23:59") & "' Or [End] >= '" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' And [End] <='" & _
Format$(EndDate, "mmm-dd-yyyy 23:59") & "' OR [Start]<'" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' AND [End]>'" & _
Format$(EndDate, "mmm-dd-yyyy 23:59") & "'")
End With
With frmViews
Set NodesCal = .treeCtl.Nodes
.treeCtl.ImageList = .ImgList
End With
With NodesCal
.Item(.Count).Selected = True
.Clear
End With
For lDate = StartDate To EndDate
If intWeek <> 0 Then Set nodX = NodesCal.Add(, , Format$(lDate,
"ddddd") & "a", vbNullString)
If intWeek = 0 Or intWeek <> Format(lDate, "WW", vbMonday) Then
intWeek = Format(lDate, "WW", vbMonday)
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd") & "w", _
String(22, 175) & " Week " & intWeek & " (" & 52 - intWeek
& ")")
nodX.Bold = True
End If
Select Case lDate
Case Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"), "ToDay
(" & Format$(lDate, "dddd d.mmm") & ")", intDayIcon)
' NodX.BackColor = RGB(255, 200, 200)
Case Is < Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"),
Format$(lDate, "dddd d. mmm"), intDayIcon)
nodX.ForeColor = RGB(150, 150, 150)
Case Is > Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"),
Format$(lDate, "dddd d. mmm"), intDayIcon)
End Select
With nodX
.Bold = True
.Expanded = True
If Weekday(lDate, vbMonday) > 5 Then
.ForeColor = RGB(255, 0, 0)
End If
End With
Next
For Each myCalItem In myRestrictItems
With myCalItem
itemStart = .Start
itemEnd = .End
If itemEnd > itemStart And Format$(itemEnd, omHourAndMinute) =
omNullHour Then
itemEnd = Format(itemEnd - 1, omDayEnd)
End If
If itemStart < StartDate Then itemStart = StartDate
If itemEnd > EndDate Then itemEnd = EndDate
If .IsRecurring = True Then
intIcon = 9
ElseIf .ReminderSet = True Then
intIcon = 10
Else
intIcon = 2
End If
For lDate = DateValue(itemStart) To DateValue(itemEnd)
I = I + 1
If DateValue(itemStart) = lDate Then
strTxt = Format$(itemStart, "hh:nn ") & .Subject
Else
strTxt = .Subject
End If
If Len(.Location) > 0 Then strTxt = strTxt & " (" &
..Location & ")"
Select Case lDate
Case Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
Case Is < Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
NodXI.ForeColor = RGB(150, 150, 150)
Case Is > Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
End Select
If .IsRecurring = True Then
Set objRecurPattern = .GetRecurrencePattern
If objRecurPattern.RecurrenceType = olRecursYearly Then
_
NodXI.Text = "(" & DateDiff("yyyy",
objRecurPattern.PatternStartDate, lDate) & " år) " & .Subject
End If
With objCDO.GetMessage(.EntryID, _
.Parent.StoreID).Fields.Item(CdoAppt_Colors,
CdoPropSetID1)
Select Case .Value
Case 0
Case 1
NodXI.BackColor = RGB(255, 180, 180)
Case 2
NodXI.BackColor = RGB(145, 145, 255)
Case 3
NodXI.BackColor = RGB(170, 255, 170)
Case 4
NodXI.BackColor = RGB(192, 192, 192)
Case 5
NodXI.BackColor = RGB(255, 182, 108)
Case 6
NodXI.BackColor = RGB(128, 255, 255)
Case 7
NodXI.BackColor = RGB(177, 177, 101)
Case 8
NodXI.BackColor = RGB(255, 220, 220)
Case 9
NodXI.BackColor = RGB(0, 166, 166)
Case 10
NodXI.BackColor = RGB(255, 255, 155)
End Select
End With
Next
End With
Next
NodesCal(1).Selected = True
NodesCal(1).Selected = False
Set myRestrictItems = Nothing
Set nodX = Nothing
Set NodXI = Nothing
Set NodesCal = Nothing
Set objRecurPattern = Nothing
Set objCDO = Nothing
End Sub



"Sue Mosher [MVP]" <[email protected]> skrev i melding
How did you instantiate myRestrictItems? With or without Sort and
IncludeRecurrences? It's awfully hard to try to duplicate an issue without
even knowing whether you're getting master AppointmentItem objects or
individual recurrences.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
Hi,
Nice, but is there a way to read theese via Oulook?
CDO would be my prefered choice, but CDO cannot open another users Calender
(CDO 1.2)

Thanks for any reply's!

Lars

Hans-Christian Francke said:
OK, here we go - below you'll find the entire sub:

Sub showCalItems(StartDate As Date, EndDate As Date)
On Error Resume Next
Dim myRestrictItems As Items, strTxt As String
Dim myCalItem As AppointmentItem, NodesCal As Nodes, nodX As Node
Dim NodXI As Node, itemStart As Date, itemEnd As Date, lDate As Date
Dim objCDO As Object, intIcon As Integer, intDayIcon As Integer
Dim strIncr As String, I As Integer
Dim intWeek As Integer, objRecurPattern As RecurrencePattern
Dim strTempArrayText As String

Const omHourAndMinute As String = "hh:nn"
Const omNullHour As String = "00:00"
Const omDayEnd As String = "ddddd 23:59"
Const omFullMoon As String = "fullMoon"
Const omNewMoon As String = "newMoon"
Const CdoPropSetID1 = "0220060000000000C000000000000046"
Const CdoAppt_Colors = "0x8214"
Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon "", "", False, False
With
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
.Sort "[Start]"
.IncludeRecurrences = True
Set myRestrictItems = .Restrict("[Start] >= '" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' And [Start] <='" &
_
Format$(EndDate, "mmm-dd-yyyy 23:59") & "' Or [End] >= '" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' And [End] <='" & _
Format$(EndDate, "mmm-dd-yyyy 23:59") & "' OR [Start]<'" & _
Format$(StartDate, "mmm-dd-yyyy 00:00") & "' AND [End]>'" & _
Format$(EndDate, "mmm-dd-yyyy 23:59") & "'")
End With
With frmViews
Set NodesCal = .treeCtl.Nodes
.treeCtl.ImageList = .ImgList
End With
With NodesCal
.Item(.Count).Selected = True
.Clear
End With
For lDate = StartDate To EndDate
If intWeek <> 0 Then Set nodX = NodesCal.Add(, , Format$(lDate,
"ddddd") & "a", vbNullString)
If intWeek = 0 Or intWeek <> Format(lDate, "WW", vbMonday) Then
intWeek = Format(lDate, "WW", vbMonday)
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd") & "w", _
String(22, 175) & " Week " & intWeek & " (" & 52 - intWeek
& ")")
nodX.Bold = True
End If
Select Case lDate
Case Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"), "ToDay
(" & Format$(lDate, "dddd d.mmm") & ")", intDayIcon)
' NodX.BackColor = RGB(255, 200, 200)
Case Is < Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"),
Format$(lDate, "dddd d. mmm"), intDayIcon)
nodX.ForeColor = RGB(150, 150, 150)
Case Is > Date
Set nodX = NodesCal.Add(, , Format$(lDate, "ddddd"),
Format$(lDate, "dddd d. mmm"), intDayIcon)
End Select
With nodX
.Bold = True
.Expanded = True
If Weekday(lDate, vbMonday) > 5 Then
.ForeColor = RGB(255, 0, 0)
End If
End With
Next
For Each myCalItem In myRestrictItems
With myCalItem
itemStart = .Start
itemEnd = .End
If itemEnd > itemStart And Format$(itemEnd, omHourAndMinute) =
omNullHour Then
itemEnd = Format(itemEnd - 1, omDayEnd)
End If
If itemStart < StartDate Then itemStart = StartDate
If itemEnd > EndDate Then itemEnd = EndDate
If .IsRecurring = True Then
intIcon = 9
ElseIf .ReminderSet = True Then
intIcon = 10
Else
intIcon = 2
End If
For lDate = DateValue(itemStart) To DateValue(itemEnd)
I = I + 1
If DateValue(itemStart) = lDate Then
strTxt = Format$(itemStart, "hh:nn ") & .Subject
Else
strTxt = .Subject
End If
If Len(.Location) > 0 Then strTxt = strTxt & " (" &
.Location & ")"
Select Case lDate
Case Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
Case Is < Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
NodXI.ForeColor = RGB(150, 150, 150)
Case Is > Date
Set NodXI = NodesCal.Add(Format$(lDate, "ddddd"),
tvwChild, _
.EntryID & Chr(I), strTxt, intIcon)
End Select
If .IsRecurring = True Then
Set objRecurPattern = .GetRecurrencePattern
If objRecurPattern.RecurrenceType = olRecursYearly Then
_
NodXI.Text = "(" & DateDiff("yyyy",
objRecurPattern.PatternStartDate, lDate) & " år) " & .Subject
End If
With objCDO.GetMessage(.EntryID, _
.Parent.StoreID).Fields.Item(CdoAppt_Colors,
CdoPropSetID1)
Select Case .Value
Case 0
Case 1
NodXI.BackColor = RGB(255, 180, 180)
Case 2
NodXI.BackColor = RGB(145, 145, 255)
Case 3
NodXI.BackColor = RGB(170, 255, 170)
Case 4
NodXI.BackColor = RGB(192, 192, 192)
Case 5
NodXI.BackColor = RGB(255, 182, 108)
Case 6
NodXI.BackColor = RGB(128, 255, 255)
Case 7
NodXI.BackColor = RGB(177, 177, 101)
Case 8
NodXI.BackColor = RGB(255, 220, 220)
Case 9
NodXI.BackColor = RGB(0, 166, 166)
Case 10
NodXI.BackColor = RGB(255, 255, 155)
End Select
End With
Next
End With
Next
NodesCal(1).Selected = True
NodesCal(1).Selected = False
Set myRestrictItems = Nothing
Set nodX = Nothing
Set NodXI = Nothing
Set NodesCal = Nothing
Set objRecurPattern = Nothing
Set objCDO = Nothing
End Sub



"Sue Mosher [MVP]" <[email protected]> skrev i melding
How did you instantiate myRestrictItems? With or without Sort and
IncludeRecurrences? It's awfully hard to try to duplicate an issue without
even knowing whether you're getting master AppointmentItem objects or
individual recurrences.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers



Hans-Christian Francke said:
myCalItem refer to a specific AppointmentItem within a For Next loop.

For Each myCalItem In myRestrictItems
'then the code in here
Next
Click to expand...
Click to expand...
 
CDO can indeed open another user's calendar if you instantiate another Session object and do a Logon to it with the server and mailbox alias method.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 
Back
Top