Set Email catagories based on the folder name it's located in

[thommo]

Hi,
Sorry that this is such a blatant cry for help, but that's what it is!

I have hundreds of folders with names following the same format - prefix SFxxxx - Label name. So SF1234 - Project1, SF1235 - Project2 and so on. Hundreds of them.

These folders have Emails in them. Sometimes less than 10, sometimes less than 100.

I want to assign the category of all Emails under each folder, with the prefix of the folder name - so SFxxxx (left most 6 characters of folder name will work)

I have never done Outlook VBA - ever. But have done Excel numerous times.

Can anyone help tell me where to start? Like how to assign categories and recurse folders to do so on every item in each folder?

Huge thanks in advance for any help as I have to do this manually otherwise.

Alan

[gmayor]

The following should work. Try it on a sub folder with a few messages. The macro will prompt for the folder to start at and it will process that folder and the folders under it.


Option Explicit

Sub AddCategoryToSF()
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim SubFolder As Folder
Dim olNS As Outlook.NameSpace
On Error Resume Next
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.PickFolder
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1
ProcessFolder olFolder
For Each SubFolder In olFolder.folders
cFolders.Add SubFolder
Next SubFolder
Loop
lbl_Exit:
Set olFolder = Nothing
Set SubFolder = Nothing
Exit Sub
err_Handler:
GoTo lbl_Exit
End Sub


Sub ProcessFolder(oFolder As Folder)
Dim i As Long
Dim olItem As Object
'Debug.Print oFolder
For i = 1 To oFolder.items.Count
Set olItem = oFolder.items(i)
If TypeName(olItem) = "MailItem" Then
If olItem.Subject Like "SF*" Then
olItem.Categories = Left(olItem.Subject, 6)
End If
End If
Next i
lbl_Exit:
Set olItem = Nothing
Exit Sub
End Sub