Solved

Assigning categories to all e-mail in folder tree using VBA

Posted on 2009-05-08
8
701 Views
Last Modified: 2012-05-06
I have a very large mail store with a deeply-nested folder structure that I wish to flatten out by leveraging the power of categories/tags.  Given that I do not wish to manually assign tags discretely for each-and-every legacy e-mail, I would like to write some VBA enabling me to:

- highlight a selected folder
- input one or more categories
- have specified categories assigned to all e-mails underneath the selected folder

Going forward, I will use rules to automatically assign categories for all new mail as it is received.
0
Comment
Question by:Lloyd Charlier
  • 5
  • 3
8 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24342927
Hello SpatiaX,

Place the following code in a normal code module and execute allFolders.

This will cycle around every folder and for each sub folder in outlook it will ask for the categories to be assigned.  For each folder that category will be added to every message in teh folder.  Please let me know how it goes or any changes to my assumptions.

Regards,
Chris
Sub allFolders()
Dim olkApp As Outlook.Application
Dim objns As Outlook.NameSpace
Dim myfolder As Outlook.MAPIFolder
Dim strStoresItem As Variant
    
    On Error Resume Next
    Set olkApp = Outlook.Application
    Set objns = olkApp.GetNamespace("MAPI")
    For Each strStoresItem In Application.Session.Stores
        Set myfolder = objns.GetFolderFromID(strStoresItem.StoreID)
        pf_allFolders myfolder
    Next
 
Set objns = Nothing
Set olkApp = Nothing
Set myfolder = Nothing
 
End Sub
 
Sub pf_allFolders(startFolder As MAPIFolder)
Dim fldr As Outlook.MAPIFolder
Dim objItem As Object
Dim cats As String
Dim arrCats() As String
    On Error Resume Next
    
    ' process all the subfolders of this folder
    For Each fldr In startFolder.folders
        Call pf_allFolders(fldr)
    Next
    cats = InputBox("Enter COMMA SEPERATED list of categories to add to folder " & vbCrLf & startFolder.FolderPath, "Auto Add Categories")
    arrCats = Split(cats, ",")
    For Each objItem In startFolder.items
        If objItem.Type = olMail Then
            AddCat objItem, arrCats
        End If
    Next
'Set mai = Nothing
Set fldr = Nothing
End Sub
 
 
Sub AddCat(mai, arrcat As Variant)
Dim catCOunt As Integer
Dim blnChanged As Boolean
Dim maiCats() As String
Dim catstring As String
Dim dictCats As Object
Dim arrCats As Variant
Dim strAdd As String
    
    Set dictCats = CreateObject("scripting.dictionary")
    maiCats = Split(mai.CAtegories, ",")
    If UBound(maiCats) >= 0 Then
        For catCOunt = 0 To UBound(maiCats)
            strAdd = Trim(maiCats(catCOunt))
            If Not dictCats.Exists(LCase(strAdd)) Then dictCats.Add LCase(strAdd), strAdd
        Next
    End If
    If UBound(arrcat) >= 0 Then
        For catCOunt = 0 To UBound(arrcat)
            strAdd = Trim(arrcat(catCOunt))
            If Not dictCats.Exists(LCase(strAdd)) Then
                dictCats.Add LCase(strAdd), strAdd
                blnChanged = True
            End If
        Next
    End If
    If blnChanged Then
        arrCats = dictCats.items
        mai.CAtegories = ""
        For catCOunt = 0 To UBound(arrCats)
            If mai.CAtegories = "" Then
                mai.CAtegories = CStr(arrCats(catCOunt))
            Else
                mai.CAtegories = mai.CAtegories & ", " & CStr(arrCats(catCOunt))
            End If
        Next
        mai.Save
    End If
End Sub

Open in new window

0
 

Author Comment

by:Lloyd Charlier
ID: 24428582
Chris,

Sorry it took so long to reply - I've been swamped with work the past ten days or so.

Your piece of code works well but it doesn't quite work the way I need it to.  It appears that, in its current form, the code walks the entire mail store and prompts for categories to assign at each level of folder nesting.  Given the size and complexity of my mail store (1000's of folders - I know, I'm working to get rid of them!), it it possible to instead have the program begin execution only on the folder currently selected (and down) and not have it prompt for at each sub-folder level?  Ideally, I would like to highlight a top-level folder, for example, "Customers", and assign a category that is subsequently applied to every e-mail underneath that folder, regardless of how many levels of sub-folders exist.  I then might highlight one of the sub-folders and assign additional categories that are to added to whatever categories already exist for those e-mails below this point - and so on...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24428666
Should be easy enough ... add the following sub to work with pf_allFolders

Chris
Sub allTheseFolders()

Dim olkApp As Outlook.Application

Dim objns As Outlook.NameSpace

Dim myfolder As Outlook.MAPIFolder

Dim strStoresItem As Variant

    

    On Error Resume Next

    Set olkApp = Outlook.Application

    Set objns = olkApp.GetNamespace("MAPI")

    pf_allFolders Application.ActiveExplorer.CurrentFolder

 

Set objns = Nothing

Set olkApp = Nothing

Set myfolder = Nothing

 

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24428670
Sorry missed about the prompt ... what do you want - a category entered the first time and then use that category for all the folders in teh slected folder structure?

Chris
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 24428692
IN regard to the prompt and then running it down through the sub folders how about this?

Chris
Sub allTheseFolders()

Dim cat As String
 

    On Error Resume Next

    cat = InputBox("Enter the category string", "Apply Category to all Subfolders")

    pf_allFoldersCat Application.ActiveExplorer.CurrentFolder, cat

 

End Sub

Sub pf_allFoldersCat(startFolder As MAPIFolder, cat As String)

Dim fldr As Outlook.MAPIFolder

Dim objItem As Object

'Dim mai As mailitem

    On Error Resume Next

    

    ' process all the subfolders of this folder

    For Each fldr In startFolder.folders

        Call pf_allFoldersCat(fldr, cat)

    Next

    

    For Each objItem In startFolder.items

        If objItem.Type = olMail Then

            AddCat objItem, cat

        End If

    Next

'Set mai = Nothing

Set fldr = Nothing

End Sub

Open in new window

0
 

Author Closing Comment

by:Lloyd Charlier
ID: 31579704
Just what I needed - thanks Chris!
0
 

Author Comment

by:Lloyd Charlier
ID: 24488100
Chris,

The code you authored really helped wrap my head around what I ultimately was trying to achieve.  In case anyone is curious, after playing around a bit with different approaches, I eventually embellished the core code so that it could be launched from the Outlook folder context menu and when selected, the macro spawns a userform modeled after Outlook's native Category form.  The result of this effort is that I can now easily select any folder and add/replace/clear any combination of categories for all mail items underneath the selected top-level folder - all from one dialog.  I have attached a screenshot for illustration.
OutlookFolderCategorize.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24489814
Looks like you have extended the core code into something that is very specific to your needs and I hope satisfying for you to have done some of the work yourself.

THanks for the grade
Chris
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

707 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

13 Experts available now in Live!

Get 1:1 Help Now