Many organizations use shared Exchange mailboxes for support and general information email addresses and assign the responsibility to answer the inquiries to a small group of users. To help even the workload, some managers want to assign the messages to users as they arrive, round-robin style, so each user gets the same number of messages.
It's actually fairly easy to do: count the messages and use Select Case to assign a message to a person.
In these examples, I'm using an ItemAdd macro because it can watch any folder in your profile for new messages, whereas a rule only watches your account's Inbox. Outlook needs to be open to use a macro and if you are moving messages to folders in other mailboxes, the mailboxes need to be in your profile (as a shared mailbox is fine). Because the Inbox is not the default Inbox in your profile, you'll need to use the GetFolderPath macro at the end of this page.
These macros start when Outlook starts; to kickstart the macros during testing, click in the Application_Startup macro and click Run.
To watch a folder in the default mailbox in a profile, use the following line in the Application Startup macro.
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Step 1
At the top of ThisOutlookSession, add this code and add the GetFolderPath function (found at the end of this article) to a new Module. Note: if you are watching for new messages in your default mailbox and are not moving the messages to folders in another mailbox or data file, you don't need the GetFolderPath function.
Dim i As Long Private WithEvents olInboxItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.Session Set olInboxItems = GetFolderPath("Shared mailbox name\Inbox").Items Set objNS = Nothing End Sub
Step 2
Next, copy one of the ItemAdd macros below and paste it under the End Sub line in the Application_Startup macro.
Assign Categories | Move Messages to Folders
Move Messages to Other Mailboxes | Forward Messages
Assign Categories "Round Robin" style
Use the name of the mailbox as it appears in your folder list.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim strCat As String If Item.Class = olMail Then Select Case i Case 0 strCat = "Case 0" Case 1 strCat = "Case 1" Case 2 strCat = "Case 2" Case 3 strCat = "Case 3" Case 4 strCat = "Case 4" End Select Item.categories = strCat Item.Save Err.Clear End If i = i + 1 Debug.Print i If i = 5 Then i = 0 End Sub
Move Messages to Folders
In this example, I'm moving messages to a folder in the mailbox that is under the Inbox. (The messages in this screenshot were assigned the Case 0 category using the previous macro.)
If the folder is at the same level as the Inbox, use this line instead:
Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders(moveFolder)
Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim objDestFolder As Outlook.MAPIFolder Dim moveFolder As String If Item.Class = olMail Then Select Case i Case 0 moveFolder = "Folder01" Case 1 moveFolder = "Folder05" Case 2 moveFolder = "Folder10" Case 3 moveFolder = "Folder12" Case 4 moveFolder = "Folder14" End Select Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Folders(moveFolder) Item.Move objDestFolder End If Err.Clear i = i + 1 Debug.Print i If i = 5 Then i = 0 Set objDestFolder = Nothing End Sub
Move Messages to Other Mailboxes
In this example, I'm moving messages to each person's Inbox. To do this, I need the mailboxes in my profile as secondary mailboxes.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim objDestFolder As Outlook.MAPIFolder Dim moveFolder As String If Item.Class = olMail Then Select Case i Case 0 moveFolder = "Mary Contrary\Inbox" Case 1 moveFolder = "Diane Poremsky\Inbox" Case 2 moveFolder = "John Smith\Inbox" Case 3 moveFolder = "Mark Jackson\Inbox" Case 4 moveFolder = "Sue Ellen\Inbox" End Select Set objDestFolder = GetFolderPath(moveFolder) Item.Move objDestFolder End If Err.Clear i = i + 1 Debug.Print i If i = 5 Then i = 0 Set objDestFolder = Nothing End Sub
Forward Messages
If you prefer to forward messages, you'll use this code. The address in the sendTo variable can either be the users Exchange alias or their SMTP email address. Change oForward.Display to oForward.Send to send the messages automatically.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim sendTo As String Dim oForward As MailItem Dim recip As Recipient If Item.Class = olMail Then Select Case i Case 0 sendTo = "billys" Case 1 sendTo = "johnj" Case 2 sendTo = "dianep" Case 3 sendTo = "maryc" Case 4 sendTo = "henryp@mydomain.com" End Select Set oForward = Item.Forward Set recip = oForward.recipients.Add(sendTo) recip.Resolve oForward.Display 'send End If Err.Clear i = i + 1 Debug.Print i If i = 5 Then i = 0 Set recip = nothing End Sub
GetFolderPath Function
You need to use this function if the mailbox you are watching or that you are moving messages into is not the default mailbox in the profile.
' Use the GetFolderPath function to find a folder in non-default mailboxes Function GetFolderPath(ByVal FolderPath As String) As Outlook.folder Dim oFolder As Outlook.folder Dim FoldersArray As Variant Dim i As Integer On Error GoTo GetFolderPath_Error If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2) End If 'Convert folderpath to array FoldersArray = Split(FolderPath, "\") Set oFolder = Application.Session.Folders.Item(FoldersArray(0)) If Not oFolder Is Nothing Then For i = 1 To UBound(FoldersArray, 1) Dim SubFolders As Outlook.Folders Set SubFolders = oFolder.Folders Set oFolder = SubFolders.Item(FoldersArray(i)) If oFolder Is Nothing Then Set GetFolderPath = Nothing End If Next End If 'Return the oFolder Set GetFolderPath = oFolder Exit Function GetFolderPath_Error: Set GetFolderPath = Nothing Exit Function End Function
How to use these Macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To use the macro code in ThisOutlookSession:
- Expand Project1 and double click on ThisOutlookSession.
- Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
- Right-click on Project1 and choose New > Module
- Paste GetFolderPath in this Module
More information as well as screenshots are at How to use the VBA Editor
Hi,
I would like to combine 3 of the macros, first to categorize and then to forward the categorized e-mail and then move it to a specified folder. Could you please tell me how to do it?
Thanks,
Cristina
I'm assuming if category 1, then folder 1, and user 1.... you'd merge the select cases and the same with the actions -
Select Case i
Case 0
strCat = "Case 0"
movedFolder = "Folder1"
sendTo = "Billy"
Case 1
......
End Select
Item.categories = strCat
Item.Save
Set oForward = Item.Forward
Set recip = oForward.recipients.Add(sendTo)
recip.Resolve
oForward.Display 'send
Set objDestFolder = GetFolderPath(moveFolder)
Item.Move objDestFolder
End If
Hi Diane, I saw you answered my question in the other post. Thanks for try to help me. I'm sorry for my ignorance, I did not know until recently that there was programming in Outlook, I'm new to it. All I needed was that: When a new email arrives in the shared box, check if the sender is on the Global Contact List, if so, categorize as "Diamond Consultant", if not, classify as "Other Emails". Is there a practical way to do this? I tried accessing the generic email as JMaster and creating the rule but I could not figure out how to access the email key, it asks for a password and no one could tell me what it was, ie it will have to be by macro. The shared email is platform.comercial@diamond.com.br Rule to categorize as Consultant: The sender must be in the "Global Contact List". So categorize as a Consultant Diamond and the color of the category is dark blue. If it does not fit the rule does not do anything, or else, could classify as "Other Emails" and the category color is red. Please please please, help-me to do this. I'm from Brazil, and no Brazilian… Read more »
Hello Thanks for the Macro i used the same it works till the assiging the case post that its stuck at "Set objDesFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(moveFolder)" the error i get is Object not found. I put the below code in This outlook session. Dim i As Long Private WithEvents olInboxItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.Session Set olInboxItems = GetFolderPath("gl testing\Inbox").Items Set objNS = Nothing End Sub Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim strCat As String If Item.Class = olMail Then Select Case i Case 0 strCat = "Case 0" Case 1 strCat = "Case 1" Case 2 strCat = "Case 2" Case 3 strCat = "Case 3" Case 4 strCat = "Case 4" End Select Item.Categories = strCat Item.Save Err.Clear End If i = i + 1 Debug.Print i If i = 5 Then i = 0 Dim objDestFolder As Outlook.MAPIFolder Dim moveFolder As String If Item.Class = olMail Then Select Case i Case 0 moveFolder = "AV" Case 1 moveFolder = "AJ" Case 2 moveFolder = "AK" Case 3 moveFolder = "BB" Case 4 moveFolder = "SS" End Select Set objDesFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(moveFolder) Item.Move objDestFolder End If Set objDestFolder = Nothing… Read more »
>> "Set objDesFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(moveFolder)"
>> the error i get is Object not found.
each moveFolder is at the same level as the Inbox? That is where Outlook expects them. They also need to exist, outlook won't create them.
Hello Diane, Thanks for the response, The folder is under Inbox. and are already existing.
Please see attached screenshot,
Thanks
Abi Jacob
Hi Diane,
I'm creating a Macro to batch assign mail messages in the mailbox to different users. The code you mentioned is for Application start up. Can I use a command button to assign and categorise the mail messages to the users and transfer the outlook data to excel for monitoring?
Yes, you can. The macor needs just a little tweaking. I have a stub macro that could do it with no changes to theat code, but it only runs on the selected message. If you want to run it on all messages in a folder, it needs a little more tweaking.
At the simplest, you just need to change the item, dim the item, and set the item - this will run only on the selected item:
Private Sub AssignMessages()
Dim Item as Mailitem
Dim objDestFolder As Outlook.MAPIFolder
Dim moveFolder As String
Set Item = Application.ActiveExplorer.Selection.Item(1)
Dim objDestFolder As Outlook.MAPIFolder
-- snip--
Hi Diane
This is almost exactly what i was looking for. Is there any way to adapt the code to assign the emails differently than round robin? For example if i have 4 people working the emails, for every 10 emails, i want the first 3 people to get 3 each and the 4th person to get 1. so if there are 20 emails waiting to be worked, persons 1-3 would get 3 each and person 4 would get 1 for the first 10 and then again persons 1-3 would get 3 each and person 4 would get 1
thank you
Yeah, you could do that.
This line does the count, change it to 10 10: If i = 5 Then i = 0
The select case does the assigning. You need to account for 20, 0- 19, since it starts with 0. Do it like this to apply to more than one number:
Select Case i
Case 0, 1, 2
' do whatever
Case 3,4,5
' do whatever
Hi Diane
This worked amazingly. went with the option of assigning a category first and then coupled it with another macro to move the emails every 5 minutes.
Thank you i really appreciate the quick response.
I'm using the round robin macro to assign emails equally to people in a department using a shared inbox where each person has an assigned category. However, I would like to be able to create an exception if an email is a reply to a specific person (but all people are replying with the same service email). I'm thinking that an exception could be added where if the body of the email has a specific person's name (from their signature), then the macro would sort that email into that person's category before continuing the round robin sorting. Is this possible?
That should work... at the very least, because you are leaving the mail in the folder, you can skip messages that begin Re:. They won't be categorized, but would group with the original message.
If Item.Class = olMail Then
if left(lcase(item.subject, 3)) <> "re:" then
' categorize
end if
end if
Will this still work if the original message is uncategorized?
Yes, because it is skipping all messages whose subject begins with re:
Hi Diane,
I am trying to adapt the macro to assign a category by subject keyword instead of "round robin", but I am obviously missing something. In my case example, if the subject contains the world "pencil" I want it assigned to category "school"
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim strCat As String
If InStr(itm.Subject, "pencil") > 0 Then
itm.UnRead = True
itm.Categories = "school"
itm.Save
End If
End Sub
Any thoughts?
try
If Item.Class = olMail Then
Select Case True
Case InStr(1, LCase(Item.Subject), "reading")
strCat = "school"
Case InStr(1, LCase(Item.Subject), "keyword2")
strCat = "Case 1"
End Select
Item.Categories = strCat
Item.Save
I updated the code to use - i have a mistake in it.
Also, make sure you use the same object name as used in the rest of the macro: itm.Subject
I love the macro you shared. There is one more thing I need and I hope you can help out.
Here is the situation:
I have 15 members on my team that is divided into 4 member groups who handle different types of emails.
What I am looking to get done is to assign emails based on the emails in their buckets. I do not want to overload anyone in that group with too many activities.
Is there something in the script that I can add to make that work. also will this work on a generic mailbox. Thanks.
The macro will work on any mailbox - you just need to tell it what folder to point to in this line:
Set olInboxItems = GetFolderPath("Shared mailbox name\Inbox").Items
I'm not sure i understand the 'bucket' problem - if one group is working on 20 messages and the other 3 only have 10 each, you want to skip the first group?