Macro to Set Outlook's Master Category List

I upgrade, move, or reinstall the OS on my PCs fairly often so setting a master category list with a macro is useful:

Public Sub ResetCategories()

    DeleteAllCategories
   
    CreateCategory "! goals", 1, 0
    CreateCategory "! objectives", 2, 0
    CreateCategory "! projects", 3, 0
    CreateCategory "@ anywhere", 4, 0
    CreateCategory "@ computer", 5, 0
    CreateCategory "@ email", 6, 0
    CreateCategory "@ errands", 7, 0
    CreateCategory "@ home", 8, 0
    CreateCategory "@ office", 9, 0
    CreateCategory "@ phone", 10, 0
    CreateCategory "1:1", 11, 0
    CreateCategory "2 inbox", 23, 1
    CreateCategory "2 someday maybe", 24, 0
    CreateCategory "2 waiting for", 19, 0
    CreateCategory "meeting", 22, 0
    CreateCategory "holiday", 17, 0
    CreateCategory "social", 18, 0
    CreateCategory "STS", 20, 0
    CreateCategory "travelling", 21, 0
    CreateCategory "cards", 25, 0
   
End Sub

Private Sub DeleteAllCategories()
    Dim objNameSpace As NameSpace
    Dim objCategory As Category
   
    Set objNameSpace = Application.GetNamespace("MAPI")
   
    If objNameSpace.Categories.Count > 0 Then
       
        For Each objCategory In objNameSpace.Categories
            objNameSpace.Categories.Remove (objCategory.CategoryID)
        Next
       
    End If
       
    Set objCategory = Nothing
    Set objNameSpace = Nothing
   
End Sub

Private Sub CreateCategory(strCategoryName As String, intColor As Integer, intKey As Integer)
    Dim objNameSpace As NameSpace
    Dim objCategory As Category
   
    Set objNameSpace = Application.GetNamespace("MAPI")
   
    If intColor > 25 Then intColor = -1
   
    objNameSpace.Categories.Add strCategoryName, intColor, intKey
       
       
    Set objCategory = Nothing
    Set objNameSpace = Nothing
   
End Sub