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

Status
Not open for further replies.
Next, I want to see if I can change "Private Sub olItems_ItemChange(ByVal Item As Object)" to only work if the BusyStatus changes, rather than if the appointment changes. Because there might be a time where I want to remove a Busy/Tentative/O-o-Office category manually in favor of some other category, and this script won't allow it.
 
The last macro I posted removes the category if the busy state is changed.
 
The last macro I posted removes the category if the busy state is changed.
Yes it did. Also, it forces a category of Busy, Tentative, or Out of Office even if I manually decide to remove that category.

I've done some research and tinkering and some rewrites that I think provide these extra functions:
- Automatically and Immediately assign category of "Busy" when creating a new appointment (immediately when the window opens, without having to save first.)
- Only add Busy/Tentative/Out-of-Office category if I change the BusyState ... i.e. Doesn't make a category change if I change an appointment's time, subject, or any other property.
- Makes those changes immediately when the BusyState changes (without having to save to see the category changed)

Not sure if this code works correctly to invitations I receive (can't test that at home since I don't get any invitations). Crossing fingers that I didn't make any snafus. Haven't seen any in my testing here at home.

Code:
Private WithEvents myInspector As Outlook.Inspectors
Private WithEvents Item As Outlook.AppointmentItem

Private Sub Application_Startup()
    
    Set myInspector = Application.Inspectors

End Sub
Private Sub myInspector_NewInspector(ByVal Inspector As Outlook.Inspector)
    
    If TypeOf Inspector.CurrentItem Is AppointmentItem Then
        Set Item = Inspector.CurrentItem
    End If

End Sub

Private Sub Item_Open(Cancel As Boolean)
    
    If Len(Item.Subject) = 0 And Len(Item.Location) = 0 And Item.BusyStatus = 2 Then
       Item.Categories = "Busy"
    End If

End Sub

Private Sub Item_Add(ByVal Item As Object)

    Select Case Item.BusyStatus
          Case 2
              Item.Categories = "Busy" & "," & Item.Categories
              Item.Save
          Case 3
              Item.Categories = "Out of Office" & "," & Item.Categories
              Item.Save
          Case 1
              Item.Categories = "Tentative" & "," & Item.Categories
              Item.Save
      End Select

End Sub

Private Sub Item_PropertyChange(ByVal Name As String)


    If Name = "BusyStatus" Then

        Dim strCat As String
        Dim arrCat As Variant

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

            Case 1
            If InStr(Item.Categories, "Tentative") = 0 Then
                Item.Categories = "Tentative" & "," & Item.Categories
            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
 
I don't think it will work with meetings - at least not new meetings - because of this:
If TypeOf Inspector.CurrentItem Is AppointmentItem Then

The change macro should work with meetings.
 
I don't think it will work with meetings - at least not new meetings - because of this:
If TypeOf Inspector.CurrentItem Is AppointmentItem Then

The change macro should work with meetings.
You are correct! Just got to work and tested it out. Everything works fine except meetings that I'm invited to.
 
I seem to have achieved it like this:
Code:
Dim myMtg As Outlook.MeetingItem

If TypeOf Inspector.CurrentItem Is AppointmentItem Then
    Set objAppointment = Inspector.CurrentItem
ElseIf TypeOf Inspector.CurrentItem Is MeetingItem Then
    Set myMtg = Inspector.CurrentItem.GetAssocitedAppointment(False)
    Set objAppointment = myMtg
End If

Mostly seems to be working. I am seeing weird behavior as follows:
- If I set an appointment to busy/tent/outofoffice it categorizes fine
- If I reply to a meeting request as "Accept" or "Tentative" then it categories fine
- If I open any appointment or meeting on my calendar and then change to busy/tent/outofoffice it re-categorizes fine
- If I right-click on any appointment or meeting on my calendar and then change the BusyStatus it re-categorizes fine
- But, if I then right-click on a different appointment or meeting and then change the BusyStatus it will NOT re-categorize...
- But then if I open one and change BusyStatus it will be fine....
- and if I then right-click it will do fine.

So, right-clicking a second one in a row will not work.
 
I seem to have achieved it like this:
Code:
Dim myMtg As Outlook.MeetingItem

If TypeOf Inspector.CurrentItem Is AppointmentItem Then
    Set objAppointment = Inspector.CurrentItem
ElseIf TypeOf Inspector.CurrentItem Is MeetingItem Then
    Set myMtg = Inspector.CurrentItem.GetAssocitedAppointment(False)
    Set objAppointment = myMtg
End If

Mostly seems to be working. I am seeing weird behavior as follows:
- If I set an appointment to busy/tent/outofoffice it categorizes fine
- If I reply to a meeting request as "Accept" or "Tentative" then it categories fine
- If I open any appointment or meeting on my calendar and then change to busy/tent/outofoffice it re-categorizes fine
- If I right-click on any appointment or meeting on my calendar and then change the BusyStatus it re-categorizes fine
- But, if I then right-click on a different appointment or meeting and then change the BusyStatus it will NOT re-categorize...
- But then if I open one and change BusyStatus it will be fine....
- and if I then right-click it will do fine.

So, right-clicking a second one in a row will not work.
Actually, this weird behavior exists without the "MeetingItem" addition....
 
Mostly seems to be working. I am seeing weird behavior as follows:
- If I set an appointment to busy/tent/outofoffice it categorizes fine
- If I reply to a meeting request as "Accept" or "Tentative" then it categories fine
- If I open any appointment or meeting on my calendar and then change to busy/tent/outofoffice it re-categorizes fine
- If I right-click on any appointment or meeting on my calendar and then change the BusyStatus it re-categorizes fine
- But, if I then right-click on a different appointment or meeting and then change the BusyStatus it will NOT re-categorize...
- But then if I open one and change BusyStatus it will be fine....

- and if I then right-click it will do fine.

So, right-clicking a second one in a row will not work.
this has to do with inspectors and picking up the changed selection. I'm not sure if there is a way around it, short of not doing two in a row or opening the second one.
 
this has to do with inspectors and picking up the changed selection. I'm not sure if there is a way around it, short of not doing two in a row or opening the second one.
Diane - this works on invitations I receive, but only if I double-click to open them first. In other words --

1. Receive invitation
2. Click accept or tentative from preview pane
3. Meeting accepted, but no categorization

1. Receive invitation
2. Double-click invitation to open it
3. Click accept or tentative from the opened invitation
4. Meeting accepted, categorization works automatically according to the script

I will try your advice in here:
 
That is based on setting the appointment Private
1614013651389.png
 
Should have been more clear. It shows me how to work off of items I double-clicked to open and/or those selected in the main window. By integrating parts of below into what we've already created, everything seems to work fine (except trying to change multiple items in a row from the calendar window):
Code:
Private WithEvents objInspectors As Outlook.Inspectors
Private WithEvents objExplorer As Outlook.Explorer
Private WithEvents objCalendarItem As Outlook.AppointmentItem

Private Sub Application_Startup()
    Set objInspectors = Outlook.Application.Inspectors
    Set objExplorer = Outlook.Application.ActiveExplorer
End Sub

Private Sub objExplorer_SelectionChange()
    On Error Resume Next
    If TypeOf objExplorer.Selection.Item(1) Is AppointmentItem Then
       Set objCalendarItem = objExplorer.Selection.Item(1)
    End If
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If TypeOf Inspector.currentItem Is AppointmentItem Then
       Set objCalendarItem = Inspector.currentItem
    End If
End Sub
 
Ah yes, that will work.
 
Aha! Found another case where it doesn't work.

If I open or select an email, and then click the meeting button to "Reply All with Meeting", the script doesn't get triggered.

This script is already supposed to trigger on Explorer_SelectionChange; Inspectors_NewInspector; Appointment_Open, Appointment_Add, and Appointment_PropertyChange....so clearly converting a mailitem to an appointmentItem/MeetingItem is not triggered by one of those.

Any idea what event I can trigger off of having an email selected/open and hitting the meeting button?
 
Last edited:
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Changing Colors or Font Styles on the Outlook Bar Using Outlook 1
J Calendar events created on iPhone automatically changing default alert from 'None' to 'Time of Event' Using Outlook.com accounts in Outlook 0
F Auto changing email subject line in bulk Using Outlook 2
K Changing the Deleted Items location in Outlook 2019 Using Outlook 2
MattC Changing the font of an email with VBA Outlook VBA and Custom Forms 1
V Outlook 2021 Can anyone explain why my Outlook views keep changing?! Using Outlook 2
wayneame Changing the Form Used by Existing Task Items in a Folder Outlook VBA and Custom Forms 4
S Changing Message Class Outlook VBA and Custom Forms 4
C Pop Server Changing Verizon/Aol to Yahoo Using Outlook 6
P Outlook tasks keeps changing (updating) dates that I type Using Outlook 2
e_a_g_l_e_p_i Changing where data .pst is saved to Using Outlook 3
P Changing the font that the task view shows Using Outlook 5
T Changing Sent Items location in Outlook 2019 Using Outlook 0
E Outlook view grouping keeps changing Using Outlook 3
B BCC issues after changing root folder path for gmail Using Outlook 1
M Changing the preferred order for "Put this entry in" list for adding new contacts to the Address Book Using Outlook 1
J Outlook 2010 Changing events in Outlook calendar via opening file, importing CSV Using Outlook 0
A .restrict results changing after moving to Exchange online Outlook VBA and Custom Forms 0
T Outlook Contacts ... Changing Font Size, Style, Bold, etc. Using Outlook 2
N Rule for "on behalf of" - with changing names Using Outlook 2
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
M Outlook 2016: Changing default font for Notes and Reading Pane Using Outlook 4
V Changing default date for task follow-up buttons Using Outlook 2
Gary Hile Outlook 2016 changing editor options Using Outlook 6
J Outlook Rules - Changing auto-submit address in multiple rules, according to rule name Outlook VBA and Custom Forms 0
S Problems syncing emails with webmail after changing to Outlook 2016 Using Outlook 1
T Changing default Mail Account in Outlook 2016 - POP3 Using Outlook 1
S Changing notification sound for new incoming messages in Outlook 365/2016 Using Outlook 1
Stephen Weinberg Changing the mailing address checkbox Using Outlook 0
D Outlook 2013 changing iCloud reminder time? Using Outlook 0
C Changing the name of Outlook Messages saved to a folder Using Outlook 1
A Outlook.com changing appointments Using Outlook 8
B Changing CC list to .add Outlook VBA and Custom Forms 2
Diane Poremsky Changing the Message Size in Exchange Server Using Outlook 0
R changing FW: on forward Outlook VBA and Custom Forms 3
B changing Win7 default backup schedule for Previous Versions Using Outlook 0
Diane Poremsky Changing the default *.pst and *.ost sizes Using Outlook 0
P Message Class keeps changing back to IPM.Contact Outlook VBA and Custom Forms 2
C Macro to send email after changing from address and adding signature Outlook VBA and Custom Forms 1
Diane Poremsky Changing Outlook.com color schemes Using Outlook 0
R Outlook calendar appointments Free/Busy time is changing from "Busy" to "Free" Using Outlook 2
W Changing looks of emails in Outlook 2003 Using Outlook 0
L Office 365 Outlook changing default contact folder Using Outlook 0
Diane Poremsky Changing the From Domain in Office 365 Using Outlook 0
R The changing way to access information in Office 365 Using Outlook 0
N Creating or changing the main new mail message template in Outlook 2010 Using Outlook 2
T issue changing [Type] in dbo.ContactMainTable/ contacts seem to be deleted BCM (Business Contact Manager) 5
William Yeack Outlook/Exchange - Changing display of “From” user Using Outlook 3
divan VbaProject: Changing email format Using Outlook 15
C Changing Domain -- Assigned To User field Migration? BCM (Business Contact Manager) 1

Similar threads

Back
Top