Changing colors of today's appointments, but not recurring ones

[schwarznavy]

Using conditional formatting, I can change the colors of today's appointments by using the criteria "Starts" and setting to today. For some reason, that also affects any and all recurring appointments. Why?

I can add an additional criteria of "reccuring = no" but then that removes any recurring appointments for today.

Is there a way to apply conditional formating to only and all of today's appointments?

 

[Diane Poremsky]

Recurring appointments are weird - the recurrence pattern makes it seem like it should be on every day within the recurrence period, so start filters fail. If you don't have a ton of recurring events, don't worry about it. If you have a lot, add recurring no - they'll still be on the calendar, mixed with the other highlighted appointments.

Also, Conditional formatting won't work on appointments that have categories.

 

[schwarznavy]

Thanks Diane. I knew about "recurring no" but I do have lots of recurring appointments. The mixture of formatted and non-formatted colored appointments doesn't sit well with me.

A tangent -- still upset that I can't get conditional formatting on the To-Do Bar Calendar!

 

[schwarznavy]

Diane - as an alternative - I'm thinking to automatically categorize appointments based on "Show As" status. I found your script on categorizing appointments based on subject here: How to Auto Assign a Color Category to New Appointments via Outlook VBA

First, the script throws me a compile error when I startup Outlook. The "WithEvents olItems As Outlook.Items" is highlighted and it says "Invalid attribute in Sub or Function."

Unfortunately, I'm starting to learn javascript but haven't gotten around to VBA. Once I can get past that error, I figure I will play around with the .busystatus property (AppointmentItem.BusyStatus property (Outlook)) instead of subject...

 

[schwarznavy]

Actually, figured it out.

I already had macros. At the top there were already several "WithEvents" lines. So I moved yours to the top. I changed Public to Private. Also, I already had a section with Application_Startup(). I moved the olItems line into that. Now it works based on subject.

 

[schwarznavy]

Follow-on -- using Select Case Item.BusyStatus works, following the constants returned (BusyStatus Property (AppointmentItem Object)).

Now I'd like to make it work whenever I change an appointment's busystatus. For example, I saved it earlier set to "Busy" but then later I change it to "Tentative."

 

[schwarznavy]

Diane - as an alternative - I'm thinking to automatically categorize appointments based on "Show As" status. I found your script on categorizing appointments based on subject here: How to Auto Assign a Color Category to New Appointments via Outlook VBA

First, the script throws me a compile error when I startup Outlook. The "WithEvents olItems As Outlook.Items" is highlighted and it says "Invalid attribute in Sub or Function."

Unfortunately, I'm starting to learn javascript but haven't gotten around to VBA. Once I can get past that error, I figure I will play around with the .busystatus property (AppointmentItem.BusyStatus property (Outlook)) instead of subject...

Oops. That wasn't your script. I had too many window up!

 

[Diane Poremsky]

A tangent -- still upset that I can't get conditional formatting on the To-Do Bar Calendar!

Color categories, yes, formatting - no. But Tasks can be filtered and formatted.

First, the script throws me a compile error when I startup Outlook. The "WithEvents olItems As Outlook.Items" is highlighted and it says "Invalid attribute in Sub or Function."

Is the macro in ThisOutlookSession or in a module? WithEvents goes at the top of thisoutlook session.

I already had macros. At the top there were already several "WithEvents" lines. So I moved yours to the top. I changed Public to Private. Also, I already had a section with Application_Startup(). I moved the olItems line into that. Now it works based on subject.

Yeah. That is exactly what you needed to do. The public and private stuff doesn't usually make a difference - unless you have two macros with the same name in different modules. Then private can only be called by other macros in that module.

Now I'd like to make it work whenever I change an appointment's busystatus. For example, I saved it earlier set to "Busy" but then later I change it to "Tentative."

You can watch the folder and when a new item is added, set a category if the status is busy.

there is an example here to watch for changes and do something -

VBA: Copy New Appointments to Another Calendar

Use a VBA macro to watch for new appointments added to Outlook's calendar and copy the appointments to a second calendar. Watch for updates and change the copied appointment.

www.slipstick.com

It's doing a look up in another calendar - so I guess it not a good example.


Not tested - and you need to set the curCal object to the calendar you are watching.... but something like this should work.

Private Sub curCal_ItemChange(ByVal Item As Object)

if Item.BusyStatus = olBusy then 
item.categories = "Whatever"
item.save ' may not be required
end if
 
End Sub

 

[Diane Poremsky]

This might be a better example - I will add an automated macro to it.

Change Insight's Focus Time Appointments

Add categories and change to Tentative the Focus Time appointments created by the Insights feature of Office 365 Exchange Online.

www.slipstick.com

 

[schwarznavy]

Trying to combine your examples with this one (Trigger Macro on Category Change/Add).

Will report back.

 

[schwarznavy]

Private Sub Items_ItemChange(ByVal Item As Object) Dim Appt As Outlook.AppointmentItem If Item.Class = olAppointment Then Select Case Item.BusyStatus Case 2 Item.Categories = "Busy" Item.Save Case 3 Item.Categories = "Out of Office" Item.Save Case 1 Item.Categories = "Tentative" Item.Save End Select End If End Sub

Next - figure out how to not blow away any other categories that may be set on the items.

 

[Diane Poremsky]

Next - figure out how to not blow away any other categories that may be set on the items.

You need to use an array.

I have an example here -

Macro to Add or Remove a Category

Use a macro to toggle a category on and off on a Microsoft Outlook email message.

www.slipstick.com

 

[Diane Poremsky]

Would help if I could read. If you are just adding, use

item.categories = "new category" & item.categories

That should put it first - switch it to put the new one at the end:
item.categories = item.categories & "new category"

 

[schwarznavy]

I can't get it to work on changes, but it does work on new appointments. I basically duplicated much of the code for _ItemAdd and _ItemChange as follows. Any idea what I'm doing wrong? When I add an appointment - even if I've added a different category - the appropriate additional category will be added bepending on the BusyStatus. When I change an appointment's BusyStatus, there is no change of category.

Private WithEvents olItems As Outlook.Items
Private WithEvents olItem2 As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Initialize_handler()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set olItems2 = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewAppt As Outlook.AppointmentItem

    If Item.Class = olAppointment Then
        Set NewAppt = Item
        
        Select Case Item.BusyStatus
            Case 2
                Item.Categories = Item.Categories & "," & "Busy"
                Item.Save
            Case 3
                Item.Categories = Item.Categories & "," & "Out of Office"
                Item.Save
            Case 1
                Item.Categories = Item.Categories & "," & "Tentative"
                Item.Save
        End Select
        
    End If
End Sub

Private Sub olItems2_ItemChange(ByVal Item As Object)
    Dim Appt As Outlook.AppointmentItem

    If Item.Class = olAppointment Then
        Set Appt = Item2
        Select Case Item.BusyStatus
            Case 2
                Item.Categories = Item.Categories & "," & "Busy"
                Item.Save
            Case 3
                Item.Categories = Item.Categories & "," & "Out of Office"
                Item.Save
            Case 1
                Item.Categories = Item.Categories & "," & "Tentative"
                Item.Save
        End Select
        
    End If
End Sub

 

[Diane Poremsky]

I have not had a chance to test your full macro - but this -
Set Appt = Item2
should be
Set Appt = Item

 

[Diane Poremsky]

This is working to add the category once on changes - its using the olitems in app startup, not Initialize_handler - without the If lines, it added a ton of categories on change. But... you really need to remove the busy state category on changes, not add to it. But its a start.

Private Sub olItems_ItemChange(ByVal Item As Object)

    If Item.Class = olAppointment Then
    
        Select Case Item.BusyStatus
            Case 2
            If InStr(Item.Categories, "Busy") = 0 Then
                Item.Categories = Item.Categories & "," & "Busy"
                Item.Save
            End If
            Case 3
            If InStr(Item.Categories, "Out of Office") = 0 Then
                Item.Categories = Item.Categories & "," & "Out of Office"
                Item.Save
            End If

            Case 1
            If InStr(Item.Categories, "Tentative") = 0 Then
                Item.Categories = Item.Categories & "," & "Tentative"
                Item.Save
            End If
          
        End Select

    End If
End Sub

 

[Diane Poremsky]

This is removing the old categories, if you changed the busy type.

Private Sub olItems_ItemChange(ByVal Item As Object)

If Item.Class = olAppointment Then


Dim strCat As String
Dim arrCat As Variant


        Select Case Item.BusyStatus
            Case 2
            If InStr(Item.Categories, "Busy") = 0 Then
                Item.Categories = Item.Categories & "," & "Busy"
                Item.Save
            End If

             arrCat = Array("Out of Office", "Tentative")
            
            Case 3
            If InStr(Item.Categories, "Out of Office") = 0 Then
                Item.Categories = Item.Categories & "," & "Out of Office"
                Item.Save
            End If
            arrCat = Array("Busy", "Tentative")
            
            Case 1
            If InStr(Item.Categories, "Tentative") = 0 Then
                Item.Categories = Item.Categories & "," & "Tentative"
                Item.Save
            End If
            arrCat = Array("Out of Office", "Busy")

            Case Else
' remove the categories if not one of these
            arrCat = Array("Out of Office", "Busy", "Tentative")

        End Select
        
   arr = Split(Item.Categories, ",")
  
For j = LBound(arrCat) To UBound(arrCat)
   Debug.Print arrCat(j)
    If UBound(arr) >= 0 Then
  ' Check for Category
    For i = 0 To UBound(arr)
    Debug.Print arr(i)
      If Trim(arr(i)) = Trim(arrCat(j)) Then
        ' remove it
            arr(i) = ""
            Item.Categories = Join(arr, ",")

        End If
        Next
        End If
Next j
    Item.Save

    End If
        

End Sub

 

[schwarznavy]

Thank you Diane. I won't be able to test until I get back to work on Tuesday. But, quick question...with your suggestion above do I need to change any of the starting items, such as:

Private WithEvents olItems As Outlook.Items
Private WithEvents olItem2 As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Initialize_handler()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set olItems2 = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub

 

[schwarznavy]

Thank you Diane. I won't be able to test until I get back to work on Tuesday. But, quick question...with your suggestion above do I need to change any of the starting items, such as:

Private WithEvents olItems As Outlook.Items
Private WithEvents olItem2 As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Initialize_handler()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set olItems2 = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub

Actually, I loaded Outlook at home and tested. It works great with just this

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

 

[schwarznavy]

I also switched the order of these:

Item.Categories = Item.Categories & "," & "Busy"

to these:

Item.Categories = "Busy" & "," & Item.Categories

Since that puts my Busy/Tentative/O-o-O colors at the forefront, since the whole purpose of this was to give me better visual cues as to the BusyStatus of my appointments.