View Full Version : Making it hard to create uncategorized items in Outlook
03-30-2005, 08:43 AM
Is there a macro/add-in/hidden function in Outlook that can keep you from creating uncategorized tasks, contacts, etc.? A VBA script that brings up a dialog box saying "categorize me!" when you attempt to close the window and save the record without adding a category to the item seems like it would be trivial to code (if I knew anything about VBA).
Or preferably: after you try to save something uncategorized, the macro automatically displays a pick list of categories, and saves the record once at least one category has been chosen for it? It seems like it would be easy to implement, and it surprises me that there's nothing readily available in Outlook to do this (or if there is, it surprises me how well they've hidden it!).
03-31-2005, 04:55 PM
This is a crappy, quick-and-dirty version. Keep in touch and I'll send you a better one.
Just put the code below into a vba module, then run the OutlookCleanup macro, assign it to a button, or whatever. I've got it set to check overall for category goodness.
Public Sub OutlookCleanup()
Public Sub CheckLinksInFolder(ByVal iFolder As OlDefaultFolders)
Dim oCurrentFolder As Outlook.MAPIFolder
Dim oNamespace As Outlook.NameSpace
Dim oCurrentItem As Variant
Dim sCategory As Variant
Dim bIsGoodCategory As Boolean
Dim sNewCategory As String
Dim x As Outlook.TaskItem
Dim bIsGoodNewCategory As Boolean
Set oNamespace = Application.GetNamespace("MAPI")
Set oCurrentFolder = oNamespace.GetDefaultFolder(iFolder)
For Each oCurrentItem In oCurrentFolder.Items
' Check the categories
If Len(oCurrentItem.Categories) > 0 Then
bIsGoodCategory = CheckCategory(oCurrentItem.Categories)
If bIsGoodCategory = False Then
sNewCategory = vbNullString
bIsGoodNewCategory = False
While bIsGoodNewCategory = False
sNewCategory = InputBox("Outlook Item '" & oCurrentItem.Subject & _
"' has invalid category: " & oCurrentItem.Categories, "Check Categories")
bIsGoodNewCategory = CheckCategory(sNewCategory)
If bIsGoodNewCategory = True Then
oCurrentItem.Categories = sNewCategory
Set oCurrentFolder = Nothing
Set oNamespace = Nothing
Public Function CheckCategory(ByVal psCategory As String) As Boolean
Static cCategories As Collection
Dim sCategory As Variant
If IsEmpty(cCategories) = False Then
Set cCategories = GetMasterCategoryList
CheckCategory = False
For Each sCategory In cCategories
If psCategory = sCategory Then
CheckCategory = True
Public Function GetMasterCategoryList() As Collection
Dim cCategories As New Collection
Dim vCategories As Variant
Dim oWSHShell As Object
Dim sCategoryList As String
Dim i As Long
Dim sCategories() As String
'read the categories from the registry
'remember: it's unicode
Set oWSHShell = CreateObject("WScript.Shell")
vCategories = oWSHShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\O utlook\Categories\MasterList")
For i = 0 To UBound(vCategories)
If i Mod 2 = 0 Then
sCategoryList = sCategoryList + Chr(vCategories(i))
sCategories = Split(sCategoryList, ";")
For i = 0 To UBound(sCategories)
cCategories.Add sCategories(i), sCategories(i)
Set GetMasterCategoryList = cCategories
04-01-2005, 07:51 AM
Thanks for your help! Should this work alright with Outlook 2000? I've modified where it's looking for the registry key (to 9.0 instead of 11.0), and keep getting a type mismatch error when the script gets to UBound(vCategories).
I'll have to try this out on my wife's office computer (running Office 2003) and see how it works...
04-01-2005, 10:14 AM
Yes, it should work. I should have noticed it.
It works great - fixes a lot of problems before they get to the palm. I'll clean it up to work in real time (when you save the task).
I was thinking of making a "quick task" form that looks like this
[Category] [Person] [Due Date] [Description]
The first 2 are drop downs (from a unique list of categories and contacts), the second are optional. Person is only available if type = waiting for or agenda.
I organize my projects using a number (p25), so I was going to pick the next # off the list