Anyone good at VBScript (Outlook mail sorting solution sought...)

[DR]

I want to create a 'tool' or 'script' which does the following

Sort my mails - something like this:

jo.bloggs@companyname.com
test.email@companyname.com

Create a folder called company name and a folder below with the email extension - so it would have test.email and jo.bloggs below it

I'd like to be able to move the folder to under a different sub folder - like Company / Personal / PR Company

Then I'd like it to create a rule for each email account - and sort them all

So - anyone able to help?

Reward? Depends how well it works...

[manwithnoname]

Can you add a rule for each email address to move it to a folder?

[Funkstar]

To be honest DR, I'm not even sure what you asking, yet alone if it can be done

I was with you until you mensioned about moving it to another folder.

Those two email addresses, are they accounts, or is that people that are sending you emails?

[Moby-Dick]

I dont think you can auto create folders like that sadly

[DR]

To be honest DR, I'm not even sure what you asking, yet alone if it can be done

I was with you until you mensioned about moving it to another folder.

Those two email addresses, are they accounts, or is that people that are sending you emails?

They are inbound emails.

I get around 20,000 mails a year - I want a good way to sort them

Currently I have

Clients\Company Name\Name of Person
or

PR Companies\PR Company Name\Name of person

etc....

[DR]

I dont think you can auto create folders like that sadly

That sucks....

[Funkstar]

I dont think you can auto create folders like that sadly

Ah, ok. That makes sense now. I didn't realise DR wanted to auto-create folders like that.

Perhaps it's using a sledge hammer to crack a nut, but what about CRM instead of just Outlook/Exchange?

I don't know enough about it to say if it would work, just a thought really.

[Moby-Dick]

A proper CRM solution woudl probably do that.

[aidanjt]

I dont think you can auto create folders like that sadly

Hmm?

I'm sure it's doable with VBA Script.

On receive, get the domain name from the 'from' field, check if a folder for it already exists, if not, create it, do same for persons name, move mail.

The trickier part will be handling unknown companies in terms of categorisation.

[Moby-Dick]

true - but I'm not sure how well outlook integrates with scripts that well unless you can sign it properly

[DR]

Hmm?

I'm sure it's doable with VBA Script.

On receive, get the domain name from the 'from' field, check if a folder for it already exists, if not, create it, do same for persons name, move mail.

The trickier part will be handling unknown companies in terms of categorisation.

You up for the challenge.

Companies only end up in one category so having a lookup table might work - it could be an XML or such file which I could edit

That means if i rename j.bloggs (under company name companydomain) to James Bloggs it would then know what it is...?

[DR]

Ah, ok. That makes sense now. I didn't realise DR wanted to auto-create folders like that.

Perhaps it's using a sledge hammer to crack a nut, but what about CRM instead of just Outlook/Exchange?

I don't know enough about it to say if it would work, just a thought really.

Is there an automated solution?

Basically manually sorting mails is so dead in my eyes

I've a ton of rules but the more work I do the more mails I get....

[TAKTAK]

But surely if it did an auto sort on incoming then it would also auto sort any spam, and create loads of redundant spam folders?

Or am i over complicating?

That is assuming that you get spam?

[DR]

Everyone gets Spam - hence why my rules are off until the end of the day and I run them once.

This script would be run once i've been throught the mail

i read every single mail which comes in...

[TheAnimus]

err you could do this quite easily on the client side in VBA as you suspect.

The question is could you promote them to 'rules' on the exchange server without encuring massive slowdown.

There is also no need to worry about signing etc, that only applies to Automation addins (like C# .net ones).

Few questions, how many different domains are we talking about, how many different aliases.

Shouldn't be too hard, you'd just have to search the Personal,PR,Company bit, before creating a folder. The hard part would be any spam that got through been munged into its own domain folder!

[TheAnimus]

Yey for lunch breaks!

Option Explicit
Option Base 0
Public Const foldersToSearchNames = "Personal:Companies:Other"
Public Const newFoldersGoHereName = "MISC"

Public Sub IncomingMailMover(mail As Outlook.MailItem)
    Dim domain As String
    Dim user As String
    
    ' is it an active directory string or email?
    If InStr(mail.SenderEmailAddress, "@") > 0 Then
        user = Split(mail.SenderEmailAddress, "@")(0)
        domain = Split(mail.SenderEmailAddress, "@")(1)
    Else
        ' its an active direcotry string, ie.
        ' "/O=DOMAIN/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=USER.NAME"
        Dim chunks, s
        chunks = Split(mail.SenderEmailAddress, "/")
        For Each s In chunks
            If Len(s) > 4 Then
                If "O=" = Mid(s, 1, 2) Then
                    domain = Mid(s, 3)
                End If
                
                If "CN=" = Mid(s, 1, 3) Then
                    user = Mid(s, 4)
                End If
            End If
        Next s
    End If
      
    ' if domain has any .'s, remove.
    If InStr(domain, ".") Then domain = Split(domain, ".")(0)
      
    mail.Move (FindOrMakeFolder(domain))
End Sub

Public Function FindOrMakeFolder(name As String) As MAPIFolder
    Dim baseInbox As MAPIFolder, newFoldersHere As MAPIFolder
    Dim allowedNames
    allowedNames = Split(foldersToSearchNames, ":")
    Set baseInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
        
    Dim f As MAPIFolder, f2 As MAPIFolder
    For Each f In baseInbox.Folders
        If f.Class = olFolder Then
            If ExistInArray(allowedNames, f.name) Then
                For Each f2 In f.Folders
                    If f2.name = name Then
                        FindOrMakeFolder = f2
                        GoTo exitfunc
                    End If
                Next f2 ' next sub folder (domain name level)
            End If ' is folder we serach
            If f.name = newFoldersGoHereName Then Set newFoldersHere = f
        End If 'is folder
    Next f
    
    ' we haven't found folder, make it
    If newFoldersHere Is Nothing Then MsgBox "Unable to find new folder path."
    FindOrMakeFolder = f.Folders.Add(name, olFolder)
exitfunc:
    Dim i
    i = 0
End Function

Public Function ExistInArray(ByRef a, search As String) As Boolean
Dim s
ExistInArray = False
For Each s In a
    If s = search Then
        ExistInArray = True
        GoTo exitloop
    End If
Next s
exitloop:
End Function