One of the Outlook Blogs made a note of a tool called QuickMailSort,
something that was supposed to organize all your emails by the Company for
I downloaded and tried it out. Well - it didn't quite do what it said it
would do so I tossed it but said "maybe I should do it myself"
The following piece of code will run through your inbox folder and create
sub-folders for every company name in the contact file and then move the
messages in there. I use company name so that all messages from different
people at a single company can go in there. My first pass took about 15
seconds and sorted through about 1000 messages. I'm happy.
Here's the code.
** Create a link to Outlook and folders
** Note - I'm going directly against Folder names here because I have about
10 different PSTs in my Outlook configuration
lo = CREATEOBJECT("outlook.application")
loSpace = lo.GetNameSpace("MAPI")
loContacts = loSpace.Folders("Mailbox").Folders("Contacts")
loFolder = loSpace.Folders("Mailbox").Folders("Inbox")
** Go BACKWARDS through messages otherwise you won't find them.
FOR lni = loFolder.Items.Count TO 1 STEP -1
loMsg = lofolder.items(lni)
*** Yes I'm using TRY CATCH here because Outlook's Find sometimes bombs on
really big email addresses
IF NOT ISNULL(loFind)
** I'm only moving them if they have a company
IF NOT EMPTY(loFind.CompanyName)
** We do another try here so we can create the Folder name
lo = loFolder.Folders(loFind.Companyname)
** Do nothing