Automatically move emails between folders based on email address

[jwerth]

<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>

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