VBA program to automatically move emails between folders based on email address

[jwerth]

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:



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

[gmayor]

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:


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

[jwerth]

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.

[gmayor]

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.

[jwerth]

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

[jwerth]

Still needing assistance with program if anyone has any tips!

Thanks,
Justin

[gmayor]

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.