Outlook Sorting Emails Based on first letter

Question

I have a user that wants to sort incoming emails based on the sender's first letter in their email address. I found some things in other questions but I am having trouble actually sorting based on their email address.

Sub FilterTest()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim MyFolder As Outlook.MAPIFolder
Dim SenderName As String

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = Application.Session.Folders("[email protected]").Folders("Inbox")
Set MyFolder = Nothing

For i = olInbox.Items.Count To olInbox.Items.Count Step -1
    olInbox.Items.Item (i)
    SenderName = (olInbox.Items.Item(i).SenderEmailAddress)


        If SenderName Like "a*" Or SenderName Like "b*" Or SenderName Like "c*" Or SenderName Like "d*" Or SenderName Like "e*" Or SenderName Like "f*" Or SenderName Like "g*" Then
            MsgBox ("From a-g")
            Set MyFolder = Application.Session.Folders("[email protected]").Folders("test")
        End If
        If SenderName Like "h*" Or SenderName Like "i*" Or SenderName Like "j*" Or SenderName Like "k*" Or SenderName Like "l*" Or SenderName Like "m*" Or SenderName Like "n*" Or SenderName Like "o*" Then
            MsgBox ("From h-o")
            Set MyFolder = Application.Session.Folders("[email protected]").Folders("test 2")
        End If
        If SenderName Like "p*" Or SenderName Like "q*" Or SenderName Like "r*" Or SenderName Like "s*" Or SenderName Like "t*" Or SenderName Like "u*" Or SenderName Like "v*" Or SenderName Like "w*" Or SenderName Like "x*" Or SenderName Like "y*" Or SenderName Like "z*" Then
            MsgBox ("From p-z")
            Set MyFolder = Application.Session.Folders("[email protected]").Folders("test 3")
        End If

        If MyFolder Is Nothing Then
            MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        Else
            olInbox.Items.Item(i).Move MyFolder
        End If
Next
End Sub

I'm sure there is a better way of doing this but I'm getting nothing... It never goes into any of the if statements.

Anyone know how I can make this code work? Or maybe another way to sort based on the first letter of an email address?

Answer 1

below is an example how you can make it a bit more readable

also if oyu use SmtpAddress you shouldnt have to worry about the x400 stuff

SenderName = (olInbox.Items.Item(i).SmtpAddress)

    'A = 65
    'G = 71
    'H = 72
    'O = 79
    'P = 80
    'Z = 90
    Dim numericLetterValue As Integer

    numericLetterValue = Asc(UCase(Left(SenderName, 1)))
    If numericLetterValue > 64 And numericLetterValue < 72 Then
        MsgBox ("From a-g")
        Set MyFolder = Application.Session.Folders("[email protected]").Folders("test")
    ElseIf numericLetterValue > 71 And numericLetterValue < 80 Then
        MsgBox ("From h-o")
        Set MyFolder = Application.Session.Folders("[email protected]").Folders("test 2")
    ElseIf numericLetterValue > 79 And numericLetterValue < 91 Then
        MsgBox ("From p-z")
        Set MyFolder = Application.Session.Folders("[email protected]").Folders("test 3")
    ElseIf MyFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    Else
        olInbox.Items.Item(i).Move MyFolder
    End If

Answer 2

If you can shift the groups a bit, you can compute the index into an array of folder names:

>> aMap = Array("AH", "IP", "QZ", "QZ")
>> For nFL = Asc("A") To Asc("Z")
>>     WScript.Echo Chr(nFL), aMap((nFL - Asc("A"))\8)
>> Next
>>
A AH
B AH
C AH
D AH
E AH
F AH
G AH
H AH
I IP
J IP
K IP
L IP
M IP
N IP
O IP
P IP
Q QZ
R QZ
S QZ
T QZ
U QZ
V QZ
W QZ
X QZ
Y QZ
Z QZ
>>

Answer 3

I've found that the issue is only with internal emails because the email address comes in as the x400 address rather than the normal [email protected] so it's going to take a little more parsing

In other words, this script works for what I am trying to do.