The Rules Wizard is great for a lot of things when automatically processing incoming e-mails. However, when there's that one certain thing that you can't do with it, you can always be the Wizard yourself and write your own rules with VBA. However, one of the greatest challenges for developers programming with Outlook is learning how to effectively hook into application events. While it is relatively easy to gain access to objects on the fly, it is not entirely obvious where, when or how these objects should be managed. If Outlook automation was anything like most object models, it would be very straightforward.
Imagine this "fantasy" code:
Sub WorkWithNewMail() Dim objOutlook As Outlook.Application Dim objAllNewMail As Outlook.Items Dim objMyEmail As Outlook.MailItem Set objOutlook = New Outlook.Application Set objAllNewMail = objOutlook.NewMail For Each objMyEmail In objAllNewMail 'Do something with every e-mail received Next End Sub
Wouldn't this make things easier! Unfortunately, there is no magical NewMail collection. You have to build it, and hook into it at the proper time. What is essential is instantiating the necessary objects when Outlook starts. To begin, open the Visual Basic Editor (ALT+F11) and open the ThisOutlookSession module from the Project Explorer window. The first code that we need to add are module level variables that we'll declare in the general declarations section of the module at the top:
Option Explicit Private objNS As Outlook.NameSpace Private WithEvents objNewMailItems As Outlook.Items
The most important object in this example is objNewMailItems, as we'll soon see. The "WithEvents" statement means we are declaring this object in a way that will allow us to access not only the properties of that object, but also the events that the object exposes.
Now, we have to hook these variables up. The ThisOutlookSession module is special compared to the regular modules that you usually insert into a VBA project in Outlook - it has a "built-in" Application object variable already declared. This way you don't have to add a "Private WithEvents objApp As Outlook.Application" line or something similar in the general declarations section of the module. With that in mind, add this procedure:
Private Sub Application_Startup()
Dim objMyInbox As Outlook.MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End SubThis is essentially where it all begins. As the name of the Application_Startup event indicates, this loads when Outlook launches and is essential to ensure that we gain access to e-mails delivered to the Inbox. This is done by hooking up an event aware procedure tied to the Items collection that we retrieve from the MAPIFolder object we set from the Inbox folder. The event where all the processing on incoming e-mails occurs will be here:
Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub
Debug.Print "Message subject: " & Item.Subject
Debug.Print "Message sender: " & Item.SenderName &" (" & Item.SenderEmailAddress & ")";
End SubAnd that's really all there is to it! The Item object is checked to ensure that it is a MailItem object before we work with it any further.
Once it is validated, we can work with all the properties and methods of the MailItem object to do whatever we want with it. Just printing out the subject line and sender information to the Debug window like the example above is pretty boring, but there are all kinds of possibilities using code to work with e-mails in ways that the Rules Wizard can't handle:
- write e-mail info to a database
- automatically save attachments to the file system
- lookup the sender's Contact item and start a Word mail merge using their mailing address
- parse the message body for line items to be added to a spreadsheet
Those are just a few examples, but as long as whatever you want to do has an Object Model it can be done - you don't just have to automate Outlook or other Office applications.
There are a few caveats to mention though. If a large number of items are added to a folder at that same time, the ItemAdd event may not fire.
However, you can get around this if you use Outlook 2003 or newer. The NewMailEx event provides a list of all the unique EntryID values for e-mails that were delivered during the last Send/Receive cycle. These values can be used to retrieve each e-mail individually as in the ItemAdd event by using the NameSpace GetItemFromID method.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As
String)
Dim objNS As Outlook.NameSpace
Dim objEmail As Outlook.MailItem
Dim strIDs() As String
Dim intX As Integer
strIDs = Split(EntryIDCollection, ",")
For intX = 0 To UBound(strIDs)
Set objNS = Application.GetNamespace("MAPI")
Set objEmail = objNS.GetItemFromID(strIDs(intX))
Debug.Print "Message subject: " & objEmail.Subject
Debug.Print "Message sender:" & objEmail.SenderName &" (" & objEmail.SenderEmailAddress & ")"
Next
Set objEmail = Nothing
End SubNote: The Outlook 2003 VBA help file seems to indicate that NewMailEx only works with Exchange Server mailboxes. This is not true - try it and see with POP or IMAP accounts.
Finally, don't expect this code to process e-mails the way server-side based rules do. Outlook of course has to be running for your code rules to work. For requirements where e-mail needs to be processed 24/7, see the Exchange SDK for information on building Event Sinks that run on the server.
To take this example further, there may be situations where you need to interact with e-mails that are opened rather than received. This involves a different approach and is explained in this article: Getting a Handle on Your E-mails with VBA
How to Use VBA
Copy and paste the code from this page into your ThisOutlookSession project. To do this, click within the code, Select All using Ctrl+A, Ctrl+C to copy.
In Outlook, press Alt+F11 to open the VBA editor and expand Microsoft Outlook Objects then double click on ThisOutlookSession to open it in the editing pane and Ctrl+P to paste the code.
For more detailed instructions and screenshots, see How to use Outlook's VBA Editor
AmronN says
I have multiple email accounts/mailboxes set up in my Outlook. (my personal company account, a mailbox for windows problems, a mailbox for unix problems, and another mailbox for network problems), and I want to see if there is any way to determine the execution of one or the other code in a macro , depending on which account/mailbox the emails arrive. That is to say, if an email arrives in the Windows mailbox, a certain code of the macro is executed, if it arrives in the Linux mailbox, it executes another code within the macro and so on, executes one or the other code within a macro depending on a Which mailbox/account (FMB) does the mail arrive? Is it possible? Any ideas?... Thanks
Vic says
Thanks a lot for the instructional.
I am trying to figure out a way to trigger different modules based on different subject lines. The goal is to forward email without an FW in the subject line and a 'forwarding' header in the body of the mail. For that, I use the outlook rule which runs a script
**
Sub SendNew(Item As Outlook.MailItem)
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
objMsg.Body = Item.Body
objMsg.Subject = "FW: " & Item.Subject
objMsg.Recipients.Add "alias@domain.com"
objMsg.Send
End Sub
**
works great. problem is, I want for different names in the subject line to trigger different modules which in return will send to different email addresses. It appears that VBA accepts only one project and I cannot figure out a way to select various modules in 'rules' it offers only 1 script.
Wil Heeren says
Hello
Nice macro but here is what i would like to do.
I have several email accounts but for 1 particular account i would like to when a new email comes into that account.
1) open the email
2) reply to
3) insert an oft
4) send
5) close the email
If this is at all possible ?
Saby says
Hi ,
It is really working great .The only drawback I see is to use this code we have to keep outlook opened for all the time .Is there any way we can get the mails even if the Outlook is closed?
Please provide me solutions .
Thanks,
Saby
Diane Poremsky says
Sorry, no. Outlook needs to be open to use a macro. The only option when outlook is closed is server-side rules.
Peter Braun says
Hi,
Thank you very much for posting. I thought I had left this comment yesterday but it seems to have disappeared now. Did I do something wrong? Maybe I just didn’t post it correctly…
I’m trying to run a version of your code to watch a particular folder for new items.
The problem is that when I try to set my
WithEventsvariable, it seems to disappear after theApplication_Startupsub finishes: it’s empty in in my watch window when I run other subs and theItemAddsub I built on it doesn’t fire when an item is added.I know I’ve assigned my variable to the right folder because the correct subject prints from the
Debug.Print clntFldrItms.item(1).Subjectline.I also know that the
Application_Startupsub runs on startup because every time I open Outlook, the VBA editor opens and code has stopped at the Stop command.I’m using Outlook 2016 with an IMAP email address (gmail).
All code is in
ThisOutlookSession. Code below.Any help you can provide would be really appreciated. Thank you!
Peter
Option ExplicitPublic WithEvents clntFldrItms As Outlook.Items
Private Sub Application_Startup()
Dim clntFldr As MAPIFolder
Set clntFldr = Application.Session.GetDefaultFolder(olFolderSentMail).Folders("Client Emails")
Set clntFldrItms = clntFldr.Items
Debug.Print clntFldrItms.item(1).Subject
Stop
End Sub
Private Sub clntFldrItms_ItemAdd(ByVal item As Object)
Dim bChar As String
bChar = "/:*?™""® <>|.&@#_+©~;-+=^$!,'" & Chr(34)
Dim saveName As String
If item.Class = olMail Then
saveName = item.Subject
For x = 1 To Len(bChar)
saveName = Replace(saveName, Mid(bChar, x, 1), "-")
Next x
item.SaveAs "C:UsersUserGoogle Drive8 - VBA workPreparation for Assisted ResponderSent Messages Folder" & _
saveName & ".msg", olMSG
End If
End Sub
Peter Braun says
Hi,
I'm having a problem with trying to use this code because my Outlook.Items variable disappears after the Application_Startup sub finishes. I've put all code in ThisOutlookSession, see below for what it is. I know it runs because the Stop is executed on startup (it's just there for troubleshooting). I've also Debug.Print the item(1) in the collection and it's correct. I feel like it's a simple mistake but for the life of me I can't figure it out. Using Outlook 2016 (mistake?).
I've found another Slipstick post on this so posted there too. Hope not to be too annoying.
Thank you in advance for any help you can provide.
Peter
Option ExplicitPublic WithEvents clntFldrItms As Outlook.Items
'https://www.slipstick.com/developer/itemadd-macro/
'https://www.slipstick.com/developer/processing-incoming-e-mails-with-macros/
Private Sub Application_Startup()
Dim clntFldr As MAPIFolder
Set clntFldr = Application.Session.GetDefaultFolder(olFolderSentMail).Folders("Client Emails")
Set clntFldrItms = clntFldr.Items
Debug.Print clntFldrItms.item(1).Subject
Stop
End Sub
Private Sub clntFldrItms_ItemAdd(ByVal item As Object)
Dim bChar As String
bChar = "/:*?™""® <>|.&@#_+©~;-+=^$!,'" & Chr(34)
Dim saveName As String
If item.Class = olMail Then
saveName = item.Subject
For x = 1 To Len(bChar)
saveName = Replace(saveName, Mid(bChar, x, 1), "-")
Next x
item.SaveAs "C:UsersUserGoogle Drive8 - VBA workPreparation for Assisted ResponderSent Messages Folder" & _
saveName & ".msg", olMSG
End If
End Sub
Vit says
Can you help me? How to adapt this macro for few accounts?
Diane Poremsky says
You need to use ItemAdd macros if they are shared mailboxes - you need to 'watch' each folder - or use rules and run a script if they are added as accounts in your profile (itemadd will also work with accounts, but rules are usually easier).
Richard says
Diane,
Well what do you know? After ticking the 'Permanently delete...' option in global settings, it worked! And BTW, AutoArchive does appear to work on non-default accounts. It did for me, anyway. Thanks for your help, Diane.
Diane Poremsky says
Thanks for the update. They may have changed the behavior of autoarchive - it used to only work on the default data file. I'll have to retest it, it's been a few years.
Richard says
Yes, but should 'Permanently delete old items' in the global settings box be ticked also, or only in the specific Junk E-mail folder properties? And sadly, the POP acc't that's delivering all of the spam is not the default account. I guess I'll try changing the global settings per you suggestion, and see if maybe that works.
Diane Poremsky says
It's up to you, but I would only set that in the folder properties. Choose move old items to... and the folder setting will override it as needed. This protects you if a folder gets set to archive - they won't be deleted permanently.
Richard says
Diane,
I've tried following your procedure to empty Junk E-mail folder via AutoArchive tool. Doesn't seem to work. I have 2 POP accounts and one IMAP account in OL 2010. All the Junk email is originating from one of the POP accounts, and all headers indicate that Outlook is the one flagging them as junk. I am using the same settings which are shown in your video, but set for one day intervals. Per your video, 'Permanently delete old items' is not checked in the global settings dialog, but it is checked in the individual Junk E-mail folder AutoArchive settings. Does the global setting to permanently delete need to be checked too??? I have individually selected "Do not auto archive...' for all other mail folders because I don't want them archived. Result is an exploding Junk E-mail folder that is not being emptied. What am I doing wrong?
Richard
Diane Poremsky says
Unless things have changed, AutoArchive only works on the default data file.... but yes, you need global settings set too - you need Archive or delete old items selected.
G says
still no crashes - that was it.. thanks for your help!!
G says
i dont call it later - well it gets called when new emails come in again i guess.
hmm the process_args function has a few exit subs.. would that skip out set objemail = nothing if i left it outside the for loop?
releasing it after the delete seems to be working so far... no errors yet.. but i aint holding my breathe!
G says
hmm could it be because im deleting the email?
i added this after the delete
objEmail.Delete
Set objEmail = Nothing
and commented this after the for loop for now
Set objEmail = Nothing
Diane Poremsky says
Possibly - but unless you call the objEmail later, it shouldn't matter that it's not released until the end - but if it works, I could be wrong.
G says
here is the script in its entirety - thank you for your help - much much appreciated =)
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items
Private Sub Application_Startup()
Dim objMyInbox As Outlook.MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim objEmail As Outlook.MailItem
Dim strIDs() As String
Dim intX As Integer
Dim Args As String
strIDs = Split(EntryIDCollection, ",")
For intX = 0 To UBound(strIDs)
Set objEmail = objNS.GetItemFromID(strIDs(intX))
If objEmail.SenderEmailType = "EX" Then
If objEmail.SenderName = Application.GetNamespace("MAPI").CurrentUser Then
If objEmail.Subject = "Magenta" Then
objEmail.BodyFormat = olFormatPlain
objEmail.Save
Args = objEmail.Body
objEmail.Delete
Process_Args Args
End If
End If
End If
Next
Set objEmail = Nothing
End Sub
Private Sub Process_Args(Args As String)
Dim strPath As String
Dim dash_count As Integer
Dim WshShell As Object
Dim sBody As Variant
On Error GoTo ErrHandler:
Set WshShell = CreateObject("WScript.Shell")
strPath = WshShell.RegRead("HKLM\Software\Wow6432Node\Magenta\ScriptDir")
strPath = strPath & "\Magenta.exe"
If Dir(strPath) = "" Then
SendMessage "File Path Does Not Exist:" & vbCrLf & strPath, False
Exit Sub
End If
sBody = Split(Args, vbCrLf)
Args = sBody(0)
Args = Trim(Args)
dash_count = Len(Args) - Len(Replace(Args, "/", ""))
If dash_count 2 Then
Shell strPath & " /help " & Args
Exit Sub
End If
If InStr(Args, "/A") = 0 And InStr(Args, "/U") = 0 And InStr(Args, "/C") = 0 Then
Shell strPath & " /help " & Args
Exit Sub
End If
Shell strPath & " " & Args
ErrHandler:
'MsgBox (Err.Number)
If Err.Number = -2147024894 Then
SendMessage "Magenta has not been run on this PC:" & vbCrLf & Environ$("computername"), False
End If
End Sub
Sub SendMessage(Message As String, DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(Application.GetNamespace("MAPI").CurrentUser)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Magenta Error"
.Body = Message
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
G says
the one listed here
https://www.slipstick.com/developer/processing-incoming-e-mails-with-macros
Diane Poremsky says
There are 3 there. :) The first sample has two Next statements but only 1 For line.
Assuming the itemadd macro, you need three blocks of code (I know, its confusing the way the article is written) and they go into ThisOutlookSession. Click in Application_Startup and press the Run button then send a message to the account. It doesn't do anything useful as written - if it works, the subject, sender name and address are written to the immediate windows (View > Immediate window to see). Replace the debug.print with code that does something.
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items
Private Sub Application_Startup()
Dim objMyInbox As Outlook.MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End Sub
Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
Dim objEmail As Outlook.MailItem
'Ensure we are only working with e-mail items
If Item.Class<> OlItemType.olMailItem Then Exit Sub
Debug.Print "Message subject: " & objEmail.Subject
Debug.Print "Message sender: " & objEmail.SenderName &" (" & objEmail.SenderEmailAddress & ")";
Set objEmail = Nothing
End Sub
G says
actually to further add to my comment - the error i get is
Object variable or With block variable not set (Error 91)
Diane Poremsky says
Which macro are you using?
G says
this works great thank you for posting =)
however it crashes for me after a few emails have been received. if i restart outlook it works again but only to crash again after a few emails have been received.
any ideas?
thanks again for your help