none
Add categories to shared mailbox using VBA RRS feed

  • Question

  • Hi All

    I am trying to add category to the category list of a shared mailbox using VBA. However it gets added to my personal mailbox and not the shared mailbox. Appreciate any help/directions on this. I am using Outlook 2007.

    Thanks in advance.


    • Edited by Jeevie Thursday, November 22, 2012 6:34 AM
    • Moved by Youen Zen Friday, November 23, 2012 6:07 AM Appropriate forum for this issue (From:Visual Basic Language)
    Thursday, November 22, 2012 6:33 AM

Answers

  • Yes, but it's a hack.
     
    Before Outlook 2007 the master Categories list was stored in the registry. Starting in Outlook 2007 the master list is stored as a hidden item in the default Calendar folder for that mailbox or PST file. That hidden item has a MessageClass of "IPM.Configuration.CategoryList".
     
    Outlook 2007 also introduced something called a StorageItem, that is what's usually referred to as a hidden item. 
     
    What you'd need to do is to get a handle to that mailbox Calendar folder using NameSpace.GetSharedDefaultFolder(recip), where recip is a Recipient for the mailbox owner or someone with permissions on that mailbox.
     
    Once you have that Folder reference you'd need to use Folder.GetStorage("IPM.Configuration.CategoryList", OlStorageIdentifierType.olIdentifyByMessageClass). That would return the StorageItem object from that default calendar folder that holds the master category list for that mailbox.
     
    The list of categories is stored in a binary (PT_BINARY) property called PR_ROAMING_XMLSTREAM, which can be accessed using PropertyAccessor with the DASL string tag "http://schemas.microsoft.com/mapi/proptag/0x7C080102".
     
    Dim oCatList As Outlook.StorageItem
    Set oCatList = oFolder.GetStorage("IPM.Configuration.CategoryList", OlStorageIdentifierType.olIdentifyByMessageClass)
     
    Dim oPA As Outlook.PropertyAccessor
    Set oPA = oCatList.PropertyAccessor
     
    Dim xmlCategories As String
    xmlCategories = oPA.BinaryToString(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7C080102"))
     
    The XML looks something like this segment:
     
    <?xml version="1.0"?>
    <categories default="Red Category" lastSavedSession="1" lastSavedTime="2012-05-15T13:43:15.895" xmlns="CategoryList.xsd">
     <category name="Lists" color="2" keyboardShortcut="0" usageCount="8" lastTimeUsedNotes="1601-01-01T00:00:00.000" lastTimeUsedJournal="1601-01-01T00:00:00.000" lastTimeUsedContacts="2012-05-15T13:43:09.531" lastTimeUsedTasks="1601-01-01T00:00:00.000" lastTimeUsedCalendar="1601-01-01T00:00:00.000" lastTimeUsedMail="1601-01-01T00:00:00.000" lastTimeUsed="2012-05-15T13:43:09.531" lastSessionUsed="1" guid="{EF22D7E2-6B69-4273-B101-8330B703A6B3}"/>
     <category name="Business" color="6" keyboardShortcut="0" usageCount="5" lastTimeUsedNotes="1601-01-01T00:00:00.000" lastTimeUsedJournal="1601-01-01T00:00:00.000" lastTimeUsedContacts="1601-01-01T00:00:00.000" lastTimeUsedTasks="1601-01-01T00:00:00.000" lastTimeUsedCalendar="1601-01-01T00:00:00.000" lastTimeUsedMail="1601-01-01T00:00:00.000" lastTimeUsed="2012-05-15T13:40:05.917" lastSessionUsed="1" guid="{B6430052-3B4B-40F0-8E24-08D65B480B48}"/>
     
    You would need to get the categories list as a string, as I showed. Then you'd need to parse the string, splitting it into an array of string on VBCRLF (newline). You would then add whatever new categories you wanted, using the existing XML as a model. Then you'd need to use PropertyAccessor.SetProperty() to set the property to the new XML after converting your string back to a binary array using PropertyAccessor.StringToBinary(). Then you'd save the StorageItem so the changes are persisted.

    You'd need to hack the XML yourself, I'm not aware offhand of any publicly available information on that. FWIW, an entry such as "1601-01-01T00:00:00.000" is interpreted as "never having been used". 1/1/1601 at T00:00:00.000T00:00:00.000 is considered as a null date to MAPI/CDO.

    --
    Ken Slovak
    [MVP-Outlook]
    http://www.slovaktech.com
    Author: Professional Programming Outlook 2007
    "Jeevie" <=?utf-8?B?SmVldmll?=> wrote in message news:d0d792ee-ef90-4c46-8d3f-878e4586b0da...
    Is it possible in Outlook 2007 using any other methods/properties?

    Ken Slovak MVP - Outlook
    Tuesday, November 27, 2012 2:47 PM
    Moderator

All replies

  • Hi Jeevie,

    According to your description, this topic is Outlook related. In order to provide better support, I will move this thread to Outlook for developers forum.

    Thanks for understanding. 


    Shanks Zen
    MSDN Community Support | Feedback to us

    Friday, November 23, 2012 6:03 AM
  • show us your code
    Friday, November 23, 2012 9:34 AM
  • Hi Jeevie,

    Thank you for posting in the MSDN Forum.

    As mentioned by DamianD, please show us the code you have for further troubleshooting.

    I look forward to your reply. 

    Have a nice day.


    Quist Zhang [MSFT]
    MSDN Community Support | Feedback to us

    Friday, November 23, 2012 1:40 PM
    Moderator
  • Below is the code. The code adds the categories to personal mailbox but not the shared mailboxes attached to my profile. I have full permissions on the shared mailboxes.

    Private Sub sbRefreshCategories()
        Dim objNS As Outlook.NameSpace
        Dim objCategories As Outlook.Categories
        Dim objCategory As Outlook.Category
        Dim iCtr As Long
       
        Dim sCategoryList As String
        Dim sColorList As String
        Dim sCurrCategoryList As String
       
        Dim vCategoryList As Variant
        Dim vColorList As Variant
       
        Dim objConn As ADODB.Connection
        Dim objRS As ADODB.Recordset
        Dim sSQL As String
       
        SetupDBConn
       
        Set objConn = New ADODB.Connection
        objConn.Open gsConnStr
       
        sSQL = "SELECT "
        sSQL = sSQL & "STATUS, "
        sSQL = sSQL & "STATUSCOLOR "
        sSQL = sSQL & "FROM "
        sSQL = sSQL & "MST_STATUS "
        sSQL = sSQL & "ORDER BY "
        sSQL = sSQL & "STATUS"
       
        Set objRS = New ADODB.Recordset
        objRS.Open sSQL, objConn, adOpenDynamic, adLockOptimistic
       
        sCategoryList = ""
        sColorList = ""
        Do While Not objRS.EOF
            sCategoryList = IIf(sCategoryList = "", objRS("STATUS"), sCategoryList & "," & objRS("STATUS"))
            sColorList = IIf(sColorList = "", objRS("STATUSCOLOR"), sColorList & "," & objRS("STATUSCOLOR"))
            objRS.MoveNext
        Loop
       
        objRS.Close
        Set objRS = Nothing
        objConn.Close
        Set objConn = Nothing
       
        vCategoryList = Split(sCategoryList, ",")
        vColorList = Split(sColorList, ",")
       
        '* Obtain a NameSpace object reference
        Set objNS = Application.GetNamespace("MAPI")
        Set objCategories = objNS.Session.Categories
       
        If objCategories.Count > 0 Then
            For iCtr = 1 To objCategories.Count
                sCurrCategoryList = IIf(sCurrCategoryList = "", objCategories.Item(iCtr).Name, sCurrCategoryList & "," & objCategories.Item(iCtr).Name)
            Next
           
            For iCtr = LBound(vCategoryList) To UBound(vCategoryList)
                If InStr(sCurrCategoryList, vCategoryList(iCtr)) = 0 Then
                    Select Case vColorList(iCtr)
                        Case "Red"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Orange"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Green"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Blue"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Black"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlack, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Yellow"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Purple"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Olive"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Maroon"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Peach"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Gray"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkBlue"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkGray"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkGreen"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkMaroon"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkOlive"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkOrange"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkPeach"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkPurple"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkRed"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkSteel"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkSteel, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkTeal"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkTeal, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkYellow"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    End Select
                End If
            Next
        Else
            For iCtr = LBound(vCategoryList) To UBound(vCategoryList)
                Select Case vColorList(iCtr)
                    Case "Red"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Orange"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Green"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Blue"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Black"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlack, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Yellow"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Purple"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Olive"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Maroon"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Peach"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Gray"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkBlue"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkGray"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkGreen"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkMaroon"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkOlive"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkOrange"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkPeach"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkPurple"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkRed"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkSteel"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkSteel, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkTeal"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkTeal, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkYellow"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                End Select
            Next
        End If
       
       ' Clean up
        Set objCategory = Nothing
        Set objCategories = Nothing
        Set objNS = Nothing
    End Sub

    Saturday, November 24, 2012 4:49 AM
  • objNS.Session.Categories will always grab the categories from the default mail store, not from any shared mailbox stores.
     
    What you need to do is to get the Store object representing that mailbox from NameSpace.Stores and use Store.Categories to grab the Categories collection for that Store.

    --
    Ken Slovak
    [MVP-Outlook]
    http://www.slovaktech.com
    Author: Professional Programming Outlook 2007
    "Jeevie" <=?utf-8?B?SmVldmll?=> wrote in message news:735fd951-2bb8-418a-b53f-4c0018db0386...

    Below is the code. The code adds the categories to personal mailbox but not the shared mailboxes attached to my profile. I have full permissions on the shared mailboxes.

    Private Sub sbRefreshCategories()
        Dim objNS As Outlook.NameSpace
        Dim objCategories As Outlook.Categories
        Dim objCategory As Outlook.Category
        Dim iCtr As Long
       
        Dim sCategoryList As String
        Dim sColorList As String
        Dim sCurrCategoryList As String
       
        Dim vCategoryList As Variant
        Dim vColorList As Variant
       
        Dim objConn As ADODB.Connection
        Dim objRS As ADODB.Recordset
        Dim sSQL As String
       
        SetupDBConn
       
        Set objConn = New ADODB.Connection
        objConn.Open gsConnStr
       
        sSQL = "SELECT "
        sSQL = sSQL & "STATUS, "
        sSQL = sSQL & "STATUSCOLOR "
        sSQL = sSQL & "FROM "
        sSQL = sSQL & "MST_STATUS "
        sSQL = sSQL & "ORDER BY "
        sSQL = sSQL & "STATUS"
       
        Set objRS = New ADODB.Recordset
        objRS.Open sSQL, objConn, adOpenDynamic, adLockOptimistic
       
        sCategoryList = ""
        sColorList = ""
        Do While Not objRS.EOF
            sCategoryList = IIf(sCategoryList = "", objRS("STATUS"), sCategoryList & "," & objRS("STATUS"))
            sColorList = IIf(sColorList = "", objRS("STATUSCOLOR"), sColorList & "," & objRS("STATUSCOLOR"))
            objRS.MoveNext
        Loop
       
        objRS.Close
        Set objRS = Nothing
        objConn.Close
        Set objConn = Nothing
       
        vCategoryList = Split(sCategoryList, ",")
        vColorList = Split(sColorList, ",")
       
        '* Obtain a NameSpace object reference
        Set objNS = Application.GetNamespace("MAPI")
        Set objCategories = objNS.Session.Categories
       
        If objCategories.Count > 0 Then
            For iCtr = 1 To objCategories.Count
                sCurrCategoryList = IIf(sCurrCategoryList = "", objCategories.Item(iCtr).Name, sCurrCategoryList & "," & objCategories.Item(iCtr).Name)
            Next
           
            For iCtr = LBound(vCategoryList) To UBound(vCategoryList)
                If InStr(sCurrCategoryList, vCategoryList(iCtr)) = 0 Then
                    Select Case vColorList(iCtr)
                        Case "Red"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Orange"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Green"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Blue"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Black"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlack, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Yellow"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Purple"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Olive"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Maroon"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Peach"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "Gray"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkBlue"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkGray"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkGreen"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkMaroon"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkOlive"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkOrange"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkPeach"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkPurple"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkRed"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkSteel"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkSteel, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkTeal"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkTeal, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                        Case "DarkYellow"
                        Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    End Select
                End If
            Next
        Else
            For iCtr = LBound(vCategoryList) To UBound(vCategoryList)
                Select Case vColorList(iCtr)
                    Case "Red"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Orange"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Green"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Blue"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Black"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorBlack, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Yellow"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Purple"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Olive"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Maroon"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Peach"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "Gray"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkBlue"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkBlue, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkGray"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGray, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkGreen"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkGreen, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkMaroon"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkMaroon, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkOlive"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOlive, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkOrange"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkOrange, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkPeach"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPeach, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkPurple"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkPurple, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkRed"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkRed, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkSteel"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkSteel, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkTeal"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkTeal, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                    Case "DarkYellow"
                    Set objCategory = objNS.Categories.Add(vCategoryList(iCtr), OlCategoryColor.olCategoryColorDarkYellow, OlCategoryShortcutKey.olCategoryShortcutKeyNone)
                End Select
            Next
        End If
       
       ' Clean up
        Set objCategory = Nothing
        Set objCategories = Nothing
        Set objNS = Nothing
    End Sub


    Ken Slovak MVP - Outlook
    Monday, November 26, 2012 2:55 PM
    Moderator
  • Thanks Ken for your response. However it seems that the Stores.Categories property is available in Outlook 2013. Can you provide the syntax if this is possible in Outlook 2007.

    Thanks in advance.

    Following is the revised syntax I used and I got an error message Run-time Error 438 Object doesn't support this property or method.

        Set objStores = Application.Session.Stores
        For Each objStore In objStores
            Debug.Print objStore.DisplayName
            Debug.Print "--------------Categories-----------------"
            
            Set objCategories = objStore.Categories
            For Each objCategory In objCategories
                Debug.Print objCategory.Name
            Next
        Next

    Tuesday, November 27, 2012 10:00 AM
  • no, this API appears first in outlook 2010.
    Tuesday, November 27, 2012 10:47 AM
  • Is it possible in Outlook 2007 using any other methods/properties?
    Tuesday, November 27, 2012 10:50 AM
  • Yes, but it's a hack.
     
    Before Outlook 2007 the master Categories list was stored in the registry. Starting in Outlook 2007 the master list is stored as a hidden item in the default Calendar folder for that mailbox or PST file. That hidden item has a MessageClass of "IPM.Configuration.CategoryList".
     
    Outlook 2007 also introduced something called a StorageItem, that is what's usually referred to as a hidden item. 
     
    What you'd need to do is to get a handle to that mailbox Calendar folder using NameSpace.GetSharedDefaultFolder(recip), where recip is a Recipient for the mailbox owner or someone with permissions on that mailbox.
     
    Once you have that Folder reference you'd need to use Folder.GetStorage("IPM.Configuration.CategoryList", OlStorageIdentifierType.olIdentifyByMessageClass). That would return the StorageItem object from that default calendar folder that holds the master category list for that mailbox.
     
    The list of categories is stored in a binary (PT_BINARY) property called PR_ROAMING_XMLSTREAM, which can be accessed using PropertyAccessor with the DASL string tag "http://schemas.microsoft.com/mapi/proptag/0x7C080102".
     
    Dim oCatList As Outlook.StorageItem
    Set oCatList = oFolder.GetStorage("IPM.Configuration.CategoryList", OlStorageIdentifierType.olIdentifyByMessageClass)
     
    Dim oPA As Outlook.PropertyAccessor
    Set oPA = oCatList.PropertyAccessor
     
    Dim xmlCategories As String
    xmlCategories = oPA.BinaryToString(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7C080102"))
     
    The XML looks something like this segment:
     
    <?xml version="1.0"?>
    <categories default="Red Category" lastSavedSession="1" lastSavedTime="2012-05-15T13:43:15.895" xmlns="CategoryList.xsd">
     <category name="Lists" color="2" keyboardShortcut="0" usageCount="8" lastTimeUsedNotes="1601-01-01T00:00:00.000" lastTimeUsedJournal="1601-01-01T00:00:00.000" lastTimeUsedContacts="2012-05-15T13:43:09.531" lastTimeUsedTasks="1601-01-01T00:00:00.000" lastTimeUsedCalendar="1601-01-01T00:00:00.000" lastTimeUsedMail="1601-01-01T00:00:00.000" lastTimeUsed="2012-05-15T13:43:09.531" lastSessionUsed="1" guid="{EF22D7E2-6B69-4273-B101-8330B703A6B3}"/>
     <category name="Business" color="6" keyboardShortcut="0" usageCount="5" lastTimeUsedNotes="1601-01-01T00:00:00.000" lastTimeUsedJournal="1601-01-01T00:00:00.000" lastTimeUsedContacts="1601-01-01T00:00:00.000" lastTimeUsedTasks="1601-01-01T00:00:00.000" lastTimeUsedCalendar="1601-01-01T00:00:00.000" lastTimeUsedMail="1601-01-01T00:00:00.000" lastTimeUsed="2012-05-15T13:40:05.917" lastSessionUsed="1" guid="{B6430052-3B4B-40F0-8E24-08D65B480B48}"/>
     
    You would need to get the categories list as a string, as I showed. Then you'd need to parse the string, splitting it into an array of string on VBCRLF (newline). You would then add whatever new categories you wanted, using the existing XML as a model. Then you'd need to use PropertyAccessor.SetProperty() to set the property to the new XML after converting your string back to a binary array using PropertyAccessor.StringToBinary(). Then you'd save the StorageItem so the changes are persisted.

    You'd need to hack the XML yourself, I'm not aware offhand of any publicly available information on that. FWIW, an entry such as "1601-01-01T00:00:00.000" is interpreted as "never having been used". 1/1/1601 at T00:00:00.000T00:00:00.000 is considered as a null date to MAPI/CDO.

    --
    Ken Slovak
    [MVP-Outlook]
    http://www.slovaktech.com
    Author: Professional Programming Outlook 2007
    "Jeevie" <=?utf-8?B?SmVldmll?=> wrote in message news:d0d792ee-ef90-4c46-8d3f-878e4586b0da...
    Is it possible in Outlook 2007 using any other methods/properties?

    Ken Slovak MVP - Outlook
    Tuesday, November 27, 2012 2:47 PM
    Moderator
  • This was fantastic and this is out I did it in ol 2010

    My problem was creating a list of categories using a shared account

    Set myStores = myNameSpace.Stores

    For Each myItem In myStores
        If myItem.DisplayName = "Put Shared User Name Here" Then
            Set myStore = myItem
        End If
    Next

    '''''''''populate Category ListBox''''''''''''''
    Set myCategories = myStore.Categories

    myCatCount = myCategories.Count
    For Each Category In myCategories
        googleExport.myCategories.AddItem (Category.Name)
    Next

    Tuesday, August 27, 2013 4:55 AM
  • Yes, but it's a hack.
     
    Before Outlook 2007 the master Categories list was stored in the registry. Starting in Outlook 2007 the master list is stored as a hidden item in the default Calendar folder for that mailbox or PST file. That hidden item has a MessageClass of "IPM.Configuration.CategoryList".
     

    --
    Ken Slovak
    [MVP-Outlook]
    http://www.slovaktech.com
    Author: Professional Programming Outlook 2007
    "Jeevie" <=?utf-8?B?SmVldmll?=> wrote in message news:d0d792ee-ef90-4c46-8d3f-878e4586b0da...
    Is it possible in Outlook 2007 using any other methods/properties?

    Ken Slovak MVP - Outlook

    I get an error message at the GetStorage line 80040102 But I have full rights on the calendar.

    Friday, June 26, 2020 11:53 AM