Auto Classification of Existing Emails - Feasibility?

[Alan]

Hi All,

I have a user (one of the directors .... of course!) who has many
thousands of emails from years past to today all sitting in his sent
items box.

We don't want to delete them, and the most obvious thing would be to
just archive them to a PST file.

However, most of them relate to clients (we are a professional
services firm).

What I would really like to be able to do would be have some code that
would attempt to classify them based on a list of key words or
phrases. For example, I could supply any array of text strings, being
each of our client names (about 3,000 to 4,000 separate strings), and
have the code go through each of the emails, searching for any
incidence of any of those strings, and if found, move the email to a
sub-folder with the string name.

I realise that it might misclassify, but at least the bulk of the work
would be done, and only errors would need to be re-sorted.

Oh - I should add that there are two other directors in a similar
position so a generic solution would be very valuable!


Is that feasible? Should I just forget it, or is there some hope
here?

Thanks,

Alan.

 

[Ken Slovak - [MVP - Outlook]]

You can do that in code. Just iterate the Items collection of the folder
where the emails are located and search in the Body and Subject for each
string in the array. A simple example using the Inbox that doesn't show any
error handling or checking to make sure every item is a MailItem:

Sub MoveOldItems(aryNames() As String, oDestFolder As Outlook.MAPIFolder)
Dim oInbox As Outlook.MAPIFolder
Dim oItems As Outlook.Items
Dim oMail As Outlook.MailItem
Dim oMoved As Outlook.MailItem
Dim oOL As Outlook.Application
Dim Count As Long
Dim i As Long
Dim j As Long
Dim lngUBound As Long
Dim lngLBound As Long

' aryNames() has all the client names
lngUBound = UBound(aryNames)
lngLBound = LBound(aryNames)

Set oOL = CreateObject("Outlook.Application")
Set oInbox = oOL.Session.GetDefaultFolder(olFolderInbox)
Set oItems = oInbox.Items
Count = oItems.Count
For i = Count To 1 Step -1
Set oMail = oItems.Item(i)
For j = lngLBound To lngUBound
If InStr(1, oMail.Subject, aryNames(j) > 0 Then
'move to other folder
Set oMoved = oMail.Move(oDestFolder)
End If
Next j
Next i

'set all objects = Nothing here
End Sub