Jughead’s Journal

I am a big fan of Gmail with its great big archive button and lable feature.

I did some hunting around and made some macros to bling my outlook out!

first the result…

The Arcive button moves the email to an archive folder and the copy and move bring up a box to move them else where

The other buttons assing categories to emails so the 1800 old emails in the archive folder are now tagged for easy locating.

You move the buttons onto your tool bar by customising it, using the macros you have set up and then renaming the button and using text only.

The macros are after the break…

To create the macros you open up visual basic from the tools/macros menu.  Start a new module and cut and paste the following to seperate modules

Module 1.

Sub MoveToArchive()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

Set objNS = Application.GetNamespace(”MAPI”)
Set objFolder = objNS.Folders(”Archive Folders”).Folders(”Archive”)

If objFolder Is Nothing Then
MsgBox “This folder doesn’t exist!”, vbOKOnly + vbExclamation, “INVALID FOLDER”
End If

If Application.ActiveExplorer.Selection.Count = 0 Then

Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.UnRead = False
objItem.Move objFolder
End If
End If
Next

Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub

Module 2.

Sub ToggleCategoryHBDI()

ToggleCategoryInSelectedMailItems (”HBDI”)

End Sub

Sub ToggleCategoryIndirect()

ToggleCategoryInSelectedMailItems (”Indirect”)

End Sub

Sub ToggleCategoryAdmin()

ToggleCategoryInSelectedMailItems (”Admin”)

End Sub

Sub ToggleCategoryTRIM()

ToggleCategoryInSelectedMailItems (”TRIM”)

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)

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

Trackback URI | Comments RSS