How to assign categories to calendar items in Outlook based on a text string containing certain text

I want to use a vba macro to do what is discussed in this thread   http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_25072154.html?sfQueryTermInfo=1+10+30+assign+calendar+categori+item+outlook

The calendar items that I want to change (actually add a category to) are already assigned to a category that always contain certain text. Aditionally, part of the subject line for each of those items also always contains the same text.

For example the calendar items always are named "NRVV-xxxxxxxx", where the "x" can be variable text, but the category name always starts with "NRVV".  Likewise, the Subject line also always contains "Bkg#" somewhere in the text string.

How can I automatically search the calendar items and add them to another category if they contain one of the text blocks.

Here is the code I currently have in ThisOutlookSession, but it doesn't change (add) the category to the calendar items like I want it to.  I'd like them to all be part of the "NRVV" category that is in the Master Cetegory list.
Dim WithEvents olkCalendar As Outlook.Items

Private Sub Application_Quit()
    Set olkCalendar = Nothing
End Sub

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

Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Dim olkAppt As Outlook.AppointmentItem
    Set olkAppt = Item
    'Here are a couple of examples of category rules you can construct to assign a category'
    
    'If the phrase Project X is in the item subject, then assign it to a category called Projects'
    If InStr(1, olkAppt.Subject, "NRVV") Then AddCategory olkAppt, "NRVV"
    
    'If you are not the meeting organizer, then assign it to a category of Meetings'
    'If olkAppt.Organizer <> Session.CurrentUser Then AddCategory olkAppt, "Meetings"
    
    olkAppt.Save
End Sub

Private Sub AddCategory(olkItem As Outlook.AppointmentItem, strCategory As String)
    If olkItem.Categories = "" Then
        olkItem.Categories = strCategory
    Else
        olkItem.Categories = olkItem.Categories & "," & strCategory
    End If
End Sub

Open in new window

mycomacAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
omgangConnect With a Mentor IT ManagerCommented:
This should do the trick.

You can create a custom toolbar (Tools --> Customize) and assign the UpdateCalendarCategory sub/macro to it.  All you have to do is click the toolbar button to update all Calendar events.

OM Gang


Sub UpdateCalendarCategory()
On Error GoTo Err_UpdateCalendarCategory

    Dim olkCal As Outlook.Folder
    Dim olkApptItem As Outlook.AppointmentItem
    Dim strSubject As String, strSubjText As String, strCategory As String
    
    strSubjText = "NRVV"
    strCategory = "NRVV"
    
    Set olkCal = Session.GetDefaultFolder(olFolderCalendar)
    
    For Each olkApptItem In olkCal.Items
        strSubject = olkApptItem.Subject
        
        If InStr(1, strSubject, strSubjText) Then
            AddCategory olkApptItem, strCategory
        End If

    Next

Exit_UpdateCalendarCategory:
    Set olkApptItem = Nothing
    Set olkCal = Nothing
    Exit Sub

Err_UpdateCalendarCategory:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure UpdateCalendarCategory of VBA Document ThisOutlookSession"
    Resume Exit_UpdateCalendarCategory

End Sub

Private Sub AddCategory(olkItem As Outlook.AppointmentItem, strCategory As String)
On Error GoTo Err_AddCategory

    If olkItem.Categories = "" Then
        olkItem.Categories = strCategory
    Else
            'check to see if category is already assigned
        If InStr(1, olkItem.Categories, strCategory) = 0 Then
            olkItem.Categories = olkItem.Categories & "," & strCategory
        End If
    End If
    
    olkItem.Save

Exit_AddCategory:
    Exit Sub

Err_AddCategory:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure AddCategory of VBA Document ThisOutlookSession"
    Resume Exit_AddCategory

End Sub

Open in new window

0
 
omgangIT ManagerCommented:
mycomac, your code is working for me as expected, e.g. if I create a new Outlook appointment and include 'NRVV" in the subject line the code adds the category NRVV to the appointment item.

Is this not working for you?  Are you wanting to do this for existing appointment items?  Your code will only fire when new appointment items are created not when editing/updating existing appointment items.

OM Gang
0
 
mycomacAuthor Commented:
I doesn't seem to work for me.  The calendar items are being generated by another program and added to the Outlook calendar.  Could that be part of the issue?
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
mycomacAuthor Commented:
The outlook calendar item is being imported (or generated) by another program and then added to my Outlook Calendar.  The above code does not assign the category to those items.
0
 
omgangIT ManagerCommented:
Your code is within Outlook and fires on an event that takes place within Outlook.  If the appointment items are being added by an outside program then the ItemAdd event never fires within Outlook itself.  You'll need to modify the process to work on exsiting Calendar items and then decide how/when to run it.

I'd look at creating a sub for function to enumerate all Calendar items and check to see if the string NRVV is in the Subject.  If so, call the AddCategory sub to update the Calendar item with the specified Category.  You'll need to decide when you want to run the routine - when Outlook starts?  or you could call it/run it manually with a shortcut key sequence.

OM Gang
0
 
mycomacAuthor Commented:
Thanks. But I don't know how, what the code should be to do that.
0
 
mycomacAuthor Commented:
This code throws an error when it runs - highlighting this sub

Private Sub AddCategory(olkItem As Outlook.AppointmentItem, strCategory As String


The error message is "Compile error:  Ambiguous name detected: AddCategory"
0
 
omgangIT ManagerCommented:
Did you paste my code into ThisOutlookSesson or a seperate code module, e.g. Module1?

Do you have two procedures named AddCategory?  Copy and paste all the code from your ThisOutlookSession module.
OM Gang
0
 
mycomacAuthor Commented:
I did have it twice;

here is the first instance.  Can I just delete it?

Private Sub AddCategory(olkItem As Outlook.AppointmentItem, strCategory As String)
    If olkItem.Categories = "" Then
        olkItem.Categories = strCategory
    Else
        olkItem.Categories = olkItem.Categories & "," & strCategory
    End If
End Sub
0
 
omgangIT ManagerCommented:
Yes.
OM Gang
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.