Solved

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

Posted on 2009-05-08
8
706 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
VMware Disaster Recovery and Data Protection

In this expert guide, you’ll learn about the components of a Modern Data Center. You will use cases for the value-added capabilities of Veeam®, including combining backup and replication for VMware disaster recovery and using replication for data center migration.

 
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
 
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

MS Outlook is a world-class email client application that is mainly used for e-communication globally.  In this article, we will discuss the basic idea about MS Outlook, its advanced features, and types of MS Outlook File formats.
When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

789 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