Automatically move emails between folders based on email address

<sub>Hello,

This is my first time posting on the forum and I have never used the vba language in outlook and have used in minimally in excel. The group I work with is currently facing a problem where we receive a large number of emails that are not relevant and waste a good chunk of our time every day. I would like to eventually have a macro that redirects all emails to folders based on a string within the email address that the email was sent from. Right now I would like to create a test program that I can alter for my eventual desired intent.

I would like to have a program in VBA for outlook that will move emails from my "inbox" to a sub folder of inbox titled "My Emails" as well as "My Emails (Internal)" based on whether a certain string is within the email address that the email was sent from. If the email address that the message was sent from has "werth" in the address than I would like it directed to "My Emails". If the email address that the email was sent from has "jaw" in it than I want it directed to "My Emails (Internal)".

This is what I have written, or taken from other peoples programs. It doesn't run any help would be appreciated:</sub>

Code:

---

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.Folders("inbox")
End Sub


Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler
    Dim msg As Outlook.MailItem
    Dim destFolder As Outlook.MAPIFolder
    If TypeName(item) = "MailItem" Then
        Set msg = item
        ' check if sender email address field contains "werth"
        If InStr(msg.SenderEmailAddress, "werth") > 0 Then
            Set destFolder = Outlook.Session.Folders("My Emails")
            ' check if sender email address field contains "jaw"
            If InStr(msg.SenderEmailAddress, "jaw") > 0 Then
                Set destFolder = Outlook.Session.Folders("My Emails")
            End If
            ProgramExit:
            Exit Sub
            ErrorHandler:
            MsgBox Err.Number & " - " & Err.Description
            Resume ProgramExit
End Sub

---

You should be able to do this with a pair of Outlook rules, one for each address type, without then need for a macro.

Your macro has IF conditions that are not closed, and the folder settings are not valid. Having set a folder, you don't then move the message to the folder, but apart from that the idea is not far adrift.

The second macro (not tested) can be used from a rule, or it can be called by the first listed macro to process selected messages:

Code:

---

Option Explicit

Sub MoveSelected()
    ' Graham Mayor - http://www.gmayor.com - Last updated - 22/11/2016
    Dim olItem As Object
    For Each olItem In Application.ActiveExplorer.Selection
        If olItem.Class = OlObjectClass.olMail Then
            MoveMessage olItem
        End If
    Next olItem
    Set olItem = Nothing
    lbl_Exit:
    Exit Sub
End Sub


Private Sub MoveMessage(ByVal item As Object)
    ' Graham Mayor - http://www.gmayor.com - Last updated - 22/11/2016
    On Error GoTo ErrorHandler
    Dim destFolder As Outlook.MAPIFolder
    If TypeName(item) = "MailItem" Then
        ' check if sender email address field contains "werth"
        If InStr(item.SenderEmailAddress, "werth") > 0 Then
            Set destFolder = Session.GetDefaultFolder(olFolderInbox).folders("My Emails")
            item.Move destFolder
            ' check if sender email address field contains "jaw"
        ElseIf InStr(item.SenderEmailAddress, "jaw") > 0 Then
            Set destFolder = Session.GetDefaultFolder(olFolderInbox).folders("My Emails")
            item.Move destFolder
        End If
    End If
    ProgramExit:
    Set destFolder = Nothing
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
    GoTo ProgramExit
End Sub

---

Unfortunately I cannot get the program to run. I should mention that I need the program to run every time I receive an email and every time I start up outlook for unread emails. I tried to using your code and adding an events handler for receiving email's, but still had no luck. Thanks so much for your help.

There are two macros. The first should be run on a selected message (or messages).
The second should be used as a script associated with a rule that runs on received messages.
You don't need the event handler. You don't really need the macro as this can be done with a pair of rules (one for each e-mail address string). I use many such rules to direct incoming mail to a variety of folders.

I don't know if rules would work. Because I am in constant contact with new people from a given company I need to look for a sub string within the senders email address. Not have the emails organized based on the entire string of the senders email. I don't really understand how to do this without an event handler. I don't think I understand enough about outlook methods/properties. How would you write this without an event handler? Also your website has been a great help with some other problems I have been having.

Thank you,
Justin

Still needing assistance with program if anyone has any tips!

Thanks,
Justin

You can set up a rule to look for 'specific words in the sender's address'. This can be a domain name e.g. '@gmayor.com' would work with e-mails from my server.