vbasortingvbscriptoutlookstring-search

Outlook Sorting Emails Based on first letter


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("me@company.com").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("me@company.com").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("me@company.com").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("me@company.com").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?


Solution

  • 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("me@company.com").Folders("test")
        ElseIf numericLetterValue > 71 And numericLetterValue < 80 Then
            MsgBox ("From h-o")
            Set MyFolder = Application.Session.Folders("me@company.com").Folders("test 2")
        ElseIf numericLetterValue > 79 And numericLetterValue < 91 Then
            MsgBox ("From p-z")
            Set MyFolder = Application.Session.Folders("me@company.com").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