VBA code to add an item to the Master Category List

Posted on 2005-05-09
Last Modified: 2009-01-26
Dear Experts,

Over the past couple of days, I have been working on a utility that will automatically add recipients from email messages
as new Contacts.  The project started here:

and continued here (in which I learned how to grab the current Master Category List):

In both cases, I got great support from David (aka BlueDevilFan), but of course this question is open to all comers :)

To put the finishing touch on the project, I would like to be able to programmatically add one item to the Master
Category List.  This will have to work for Outlook 2000, Outlook XP, and Outlook 2003, as I envision distributing the
utility to users of all three applications.


Question by:Patrick Matthews
    LVL 76

    Accepted Solution


    This one was more difficult because WshShell's (Wscript.Shell) RegWrite method apparently cannot write a long binary value.  So, I had to switch and use a more complicated solution for writing the changed MCL back into the registry.  Anyway, here it is.  I tested it with Outlook 2003 and it worked fine there.  I suspect that means it'll work fine on 2002 also.  Not sure about 2000.  I think I have it right but have no means of testing it there.

    Public Const HKEY_CLASSES_ROOT = &H80000000
    Public Const HKEY_CURRENT_USER = &H80000001
    Public Const HKEY_LOCAL_MACHINE = &H80000002
    Public Const HKEY_USERS = &H80000003
    Public Const HKEY_CURRENT_CONFIG = &H80000005
    Public Const HKEY_DYN_DATA = &H80000006
    Public Const REG_SZ = 1
    Public Const REG_BINARY = 3
    Public Const REG_DWORD = 4
    Public Const ERROR_SUCCESS = 0&

    Public Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

    Public Declare Function RegCreateKey Lib "advapi32.dll" _
        Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey _
        As String, phkResult As Long) As Long

    Public Declare Function RegSetValueEx Lib "advapi32.dll" _
        Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _
        lpValueName As String, ByVal Reserved As Long, ByVal _
        dwType As Long, lpData As Any, ByVal cbData As Long) As Long

    Public Function WriteBinaryValue(ByVal lngHKey As Long, ByVal strPath As String, _
        ByVal strValueName As String, bytArray() As Byte) As Boolean
        Dim lngResult As Long, _
            lngCurKey As Long
        WriteBinaryValue = True
        lngResult = RegCreateKey(lngHKey, strPath, lngCurKey)
        If lngResult <> 0 Then
            WriteBinaryValue = False
            lngResult = RegSetValueEx(lngCurKey, strValueName, _
                0&, REG_BINARY, bytArray(0), UBound(bytArray()) + 1)
            If lngResult <> 0 Then
                WriteBinaryValue = False
            End If
            lRegResult = RegCloseKey(lngCurKey)
        End If
    End Function

    Private Function AddItemToMCL(varItem As Variant) As Boolean
        Dim arrVersion As Variant, _
            objShell As WshShell, _
            strBuffer As String, _
            varKey As Variant, _
            strPath As String, _
            strValue As String, _
            bolResult As Boolean, _
            bytArray() As Byte
        On Error GoTo ehAddItemToMCL
        strBuffer = GetMCL()
        If InStr(1, strBuffer, varItem) > 0 Then
            bolResult = False
            strBuffer = strBuffer & ";" & varItem & vbNullChar
            arrVersion = Split(Application.Version, ".")
            varKey = "HKCU"
            strValue = "MasterList"
            strPath = "Software\Microsoft\Office\" & arrVersion(0) & ".0\Outlook\Categories"
            Select Case arrVersion(0)
                Case 9      '2000
                    Set objShell = CreateObject("Wscript.Shell")
                    objShell.RegWrite varKey & "\" & strPath & "\" & strValue, strBuffer, "REG_SZ"
                    Set objShell = Nothing
                    bolResult = True
                Case 10, 11 'XP/2003
                    bytArray = strBuffer
                    bolResult = WriteBinaryValue(HKEY_CURRENT_USER, strPath, strValue, bytArray)
                Case Else
                    bolResult = False
            End Select
        End If
        AddItemToMCL = bolResult
        Exit Function
        AddItemToMCL = False
        Set objShell = Nothing
        Exit Function
    End Function
    LVL 92

    Author Comment

    by:Patrick Matthews

    Cool!  I'll test it later.

    I knew that this one was harder to do :)

    LVL 92

    Author Comment

    by:Patrick Matthews

    Works like a charm.  I made some minor tweaks (such as made the search for the proposed new item in the existing list a tad
    more sophisticated) and cleaned up a couple of minor points picked up on compile (one variable misspelled in WriteBinaryValue;
    changed declaration of objShell in AddItemToMCL to Object).

    The updated module and UserForms are available at:

    Thank you so much for your help!

    LVL 76

    Expert Comment

    by:David Lee

    Oops.  I'd meant to change objShell's declaration but obviously forgot.  Glad it worked out.  I'll grab the final product and have a look when I get a minute.

    No problem.  Glad I was able to help.

    Take care.

    -- David

    Featured Post

    How your wiki can always stay up-to-date

    Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
    - Increase transparency
    - Onboard new hires faster
    - Access from mobile/offline

    Join & Write a Comment

    Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
    This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

    754 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    25 Experts available now in Live!

    Get 1:1 Help Now