Tone's Notes

I wanted a toolbar with buttons to toggle the categories I use most often.

Start macro editor: ToolsàMacroàVisual Basic Editor

Rename the default Project1 name.

Insert a new module.

Rename the new module.

Open the module and code similar to the code below.

Add a new toolbar with buttons for each of the macros.

Change the text and or image options for each toolbar button.

By default the macros won’t run when you restart Outlook because of the default macro security level. You can lower the security level, but it isn’t that hard to sign the macro project file.

If you happen to have access to your domains certificate authority web service (e.g. http://server/certsrv), use it to request a “user” certificate and install it on your computer.

Open the Visual Basic Editor again.

Select the project file.

On the Tools menu select Digital Signature

Click Choose and select the installed certificate.

Save and exit the editor and Outlook.

The first time following this that you restart Outlook and try to run one of the macros, a security dialog will appear. Select the option to always trust yourself J.

That’s it.

Sub ToggleCategoryFamilyAndFriends()

    ToggleCategoryInSelectedMailItems ("Family & Friends")

End Sub

Sub ToggleCategoryPurchases()

    ToggleCategoryInSelectedMailItems ("Purchases")

End Sub

Sub ToggleCategorySubscriptions()

    ToggleCategoryInSelectedMailItems ("Subscriptions")

End Sub

Sub ToggleCategoryInSelectedMailItems(category As String)

    Dim newCat As String

    Dim newCats As String

    Dim oldCats As String

    Dim delim As String

    Dim mode As String

    mode = "unknown"

    delim = ", "

    newCat = category

    Dim objExplorer As Explorer

    Set objExplorer = Application.ActiveExplorer

    For Each item In objExplorer.Selection

        Dim pos As Integer

        newCats = delim + item.Categories + delim

        pos = InStr(newCats, delim + newCat + delim)

        If pos = 0 Then

            If mode = "unknown" Or mode = "add" Then

                mode = "add"

                Dim a As Variant, a1 As Variant

                a = Split(item.Categories + delim + newCat, delim)

                a1 = BubbleSort(a) ' For some reason if I don't assign to a1, a remains unchanged...

                newCats = Join(a, delim)

                item.Categories = newCats

                item.Save

            End If

        Else

            If mode = "unknown" Or mode = "remove" Then

                mode = "remove"

                newCats = Left(newCats, pos - 1) + Mid(newCats, pos + Len(delim + newCat + delim))

                If InStr(newCats, delim) = 1 Then

                    newCats = Mid(newCats, Len(delim))

                End If

                If InStrRev(newCats, delim) = Len(newCats) - Len(delim) + 1 Then

                    newCats = Left(newCats, Len(newCats) - Len(delim))

                End If

                item.Categories = newCats

                item.Save

            End If

        End If

    Next

End Sub

Function BubbleSort(ToSort As Variant, Optional SortAscending As Boolean = True) As Variant

    ' Chris Rae's VBA Code Archive - http://chrisrae.com/vba

    ' By Chris Rae, 19/5/99. My thanks to

    ' Will Rickards and Roemer Lievaart

    ' for some fixes.

    Dim AnyChanges As Boolean

    Dim b As Long

    Dim SwapFH As Variant

    Do

        AnyChanges = False

        For b = LBound(ToSort) To UBound(ToSort) - 1

            If (ToSort(b) > ToSort(b + 1) And SortAscending) _

               Or (ToSort(b) < ToSort(b + 1) And Not SortAscending) Then

                ' These two need to be swapped

                SwapFH = ToSort(b)

                ToSort(b) = ToSort(b + 1)

                ToSort(b + 1) = SwapFH

                AnyChanges = True

            End If

        Next b

    Loop Until Not AnyChanges

    BubbleSort = ToSort

End Function