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 based on sender name
The modification is in response to the question in this Microsoft Community thread, Microsoft Community thread, where the messages are assigned by the sender's name.
We need to get the first letter of the sender's name. The select case statements check to see which case is true and moves the message to a folder. The Case Else handles all messages that do not match the other case statements.
I'm using UCase function to force capitalize the letters, otherwise, someone with a lowercase display name would end up in the Else folder. If you prefer, you can force the sender names to lower case using Left(LCase(Item.SenderName), 1), but must also enter the letters in each case statement in lower case.
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 olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objDestFolder As Outlook.MAPIFolder
Dim moveFolder As String
If Item.Class = olMail Then
Debug.Print Item.SenderName, Left(Item.SenderName, 1)
Select Case Left(UCase(Item.SenderName), 1)
Case "A", "B", "C"
moveFolder = "Folder01"
Case "D", "E", "F"
moveFolder = "Folder02"
Case "G", "H", "I"
moveFolder = "Folder03"
Case Else ' letters not listed above
moveFolder = "Folder04"
End Select
Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Folders(moveFolder)
Item.Move objDestFolder
End If
Err.Clear
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
Brett says
Hey Diane,
I know this is an old thread, but I was going to see if you could help me. I am using a large combination of your code in two shared inboxes i manage at my job. The issue i am running into is trying to combine multiple round robin statements. So if the subject line has the word "Withdrawal" in it, then assign it to these three people. If the subject has the word deposit in it, assign it to these three people. The issue i am running into is in the below code, when it sees an e-mail with the subject "Withdrawal" it assigns it round robin correctly, but then the one below it, "Deposit" it always assigns it to the first person and the counter does not increase. I have tried everything and can not figure out how to make both counters work. Is there any insight you can give me?
If InStr(1, UCase(Item.Subject), UCase("Withdrawal")) Or InStr(1, UCase(Item.Body), UCase("Withdrawal")) <> 0 Then
Select Case a
Case 0
strCat = "Case 0"
Case 1
strCat = "Case 1"
End Select
Item.Categories = strCat
Item.Save
Err.Clear
End If
a = a + 1
Debug.Print a
If a = 3 Then a = 0
If InStr(1, UCase(Item.Subject), UCase("Deposit")) Or InStr(1, UCase(Item.Body), UCase("Deposit")) <> 0 Then
Select Case b
Case 0
strCat = "Case 5"
Case 1
strCat = "Case 6"
End Select
Item.Categories = strCat
Item.Save
Err.Clear
End If
b = b + 1
Debug.Print b
If b = 3 Then b = 0
Diane Poremsky says
it looks right... so Debug.Print b always puts a 0 in the immediate window?
Mariah says
Could you post code to run this with a button on all emails in a shared inbox?
I also keep getting an error at line:
Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Folders(moveFolder)
I tried using the other code for this line and it also fails. My folders are on the same level as the inbox.
Tyler says
Hi,
This macro works perfectly. How would you modify the macro to skip a folder if you do not want to assign to them or if it is not there without manually changing the macro. I am looking to have a sub folder of "Do Not Assign" that management can move folders into and out of with the code still running and assigning emails to folders under the main inbox folder.
Tyler says
Hi,
This macro works perfectly. How would you modify the macro to skip a folder if you do not want to assign to them or if it is not there without manually changing the macro.
Cristina says
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
Diane Poremsky says
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
Kauê says
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 forum or website knew how to help me with this, I've been in this for two weeks.
Thank you in advance.
ABI JACOB says
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
End Sub
and in module
the GetFolderPath code.
Can you please help?
Thanks
Diane Poremsky says
>> "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.
ABI JACOB says
Hello Diane, Thanks for the response, The folder is under Inbox. and are already existing.
Please see attached screenshot,
Thanks
Abi Jacob
Joemar Coral says
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?
Diane Poremsky says
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--
Irfan says
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
Diane Poremsky says
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
Irfan says
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.
Candace says
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?
Diane Poremsky says
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
Candace says
Will this still work if the original message is uncategorized?
Diane Poremsky says
Yes, because it is skipping all messages whose subject begins with re:
Chris S. says
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?
Diane Poremsky says
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
Diane Poremsky says
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
Edd says
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.
Diane Poremsky says
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?
S@ndeep P@tel says
Hi Diane,
Such a great solution. But one more thing regarding this solution.
It is possbile to do same thing with user's mailbox. In my organization Shred mailbox are added to user's outlook mailbox. Is it possible that any mail arrived in Shared Mailbox will move to another folder of Shared Mailbox from user's outlook vba? Because I don't know where the Shared mailbox is setup. we just use with user's mailbox.
your help highly appreciated.
Diane Poremsky says
If the shared user sets up server side rules, they will run whether outlook is open and can move the mail (unless you are using conditions or actions that force the rules client side). If rules won't work, you can use the macro on any folder open in your mailbox. You may need to use the method here to identify the shared mailbox - https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#shared
Ritesh Patil says
Hello,
I am trying to run the above steps but i am getting the below error every time i run the macro
"Object Variable or with block variable not set"
Can you please please help me.
My Code:
Under : thisOutlookSession
Dim i As Long
Public WithEvents olInboxItems As Items
Public Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath("Fulfilment.qatar\Inbox\Team Helpdesk May 2016").Items
Set objNS = Nothing
End Sub
Public 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
Under :Module 1
' 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
Thanks,
Ritesh
Diane Poremsky says
Is this spelled correctly and in the proper case?
Fulfilment.qatar\Inbox\Team Helpdesk May 2016
SturiGellar says
Hi Diane,
Great post, wasted on me as I'm obviously missing something with the round robin macro.
I'm testing this on Outlook 2007 Pro with an Exchange mailbox as primary/default inbox so haven't added the GetFolderPath section.
I've added the Step 1 and placed both ItemAdd sections which assign a category round robin and move messages to a folder beneath it. However when I try and compile it, it has an issue with the 'Private WithEvents olInboxItems As Items' statement
The error I get is - Compile Error, Only valid in object module
Hope you can help
Thanks
Stuart
azgi says
Hi Diane,
Thank you so much for sharing this macro. It is my first trying in macro, hence I just try to understand you instruction and I still must learn about each meaning of macro code. I have a question, but let me explain my first trying:
1. I double click ThisOutlookSession and I put macro code as follow
Dim i As Long Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
……..
Until
……..
Nothing End Sub
2. Then I add this one of ItemAdd Macro as follow after Nothing End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim strCat As String
……
Until
…..
Debug.Print i
If i = 5 Then i = 0
End Sub
3. Then I created module and I put this macro
' Use the GetFolderPath function to find a folder in non-default mailboxes Function GetFolderPath
…..
Until
….
Set GetFolderPath = Nothing Exit Function End Function
My question is:
1. Am I correct? But why my macro cannot be run?
2. My shared folder is xxx.support@xxx.com therefore for getFolderPath is it correct if I only state
GetFolderPath("Inbox")? Or is it supposed to be GetFolderPath("xxx.support@xxx.com \Inbox")
Diane Poremsky says
you need to use the full display name as seen in the folder list and the folder name, so GetFolderPath("xxx.support@xxx.com \Inbox") would be correct.
Is macro security set to low? Is the macro not running or not doing anything?
sorrybaws says
Hi there - I hope I'm not repeating this question but I couldn't find it elsewhere: I need to transfer mail from a shared mailbox to a .pst. How do I tell the VBA script which inbox to take mail from?
Diane Poremsky says
This is the part that tells the macro on this page where to look:
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
so, you replace the piece of code that points to the folder in your code with
GetFolderPath("Shared mailbox name\Inbox")
and get the getfolderpath function from https://www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#getfolderpath - add it to a new module or after your macro.
Nravota says
Ok, now it assigns categories to all the mails with attachments but If the messages are more than 14-15, it skips some categories in the middle, so it is not always Case 0, Case 1 and Case 2 as I want it to be. How can I fix this? It is important that the different categories appear even number of times and if the mails are more than that simply not to put category, as in your example. Here is what I came up with:
For Each obj In objItems
intcount = obj.Attachments.Count
If intcount > 0 Then
For Each oAtt In obj.Attachments
Debug.Print oAtt.Size
On Error Resume Next
If oAtt.Size 30000 Then
With obj
Select Case i
Case 0
strCat = "Nasko"
Case 1
strCat = "Kremi"
Case 2
strCat = "Gabi"
End Select
obj.Categories = strCat
obj.Save
Err.Clear
i = i + 1
Debug.Print i
If i = 3 Then i = 0
End With
End If
NextAtt:
Next
End If
Next
Felix Lu says
Is it possible to assign categories based on rules that you store "offshore". E.g. The macro refers to an excel spreadsheet where you stored the rules (The excel cells A1 & B1 stores the words Bread and Food respectively.) If an incoming mail's subject header has the word bread, the macro refers to the excel sheet and categorizes the email as Food etc.
Diane Poremsky says
you can, but it would be best to read the sheet at startup and store the values in an array - reading the sheet each time the macro runs could slow things down and increase the chances that some messages are missed.
Nravota says
Hi Diane, I am using the code to assign categories only on the mails with attachment and I added the if statement, but the code still puts categories to all the mails.. Can you pls help? Here is the code:
Option Explicit
Public Sub Assign_Categories()
Dim Ns As Outlook.NameSpace
Dim objOL As Outlook.Application
Dim i As Integer
Dim objOutlookItem As Object
Dim objItems As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Dim strCat As String
Set Ns = Application.GetNamespace("MAPI")
Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items
For Each obj In objItems
With obj
If obj.Attachments.Count > 0 Then
Select Case i
Case 0
strCat = "John"
Case 1
strCat = "Robin"
Case 2
strCat = "Gregory"
End Select
obj.Categories = strCat
obj.Save
Err.Clear
i = i + 1
Debug.Print i
If i = 3 Then i = 0
End If
End With
Next
Set obj = Nothing
Set objOutlookItem = Nothing
Set objItems = Nothing
Set objFolder = Nothing
Set objOL = Nothing
End Sub
Maybe sth with the icounter is not correct here? Thanks a lot in advance!
Diane Poremsky says
it looks to me like its because the attachment check is inside the With. Try it outside of the With, if nothing else, it'll jump to the next message a split second faster.
Nravota says
Hi Diane,
Thank you for this link, I successfully adapted it. I just wanted to ask you if there is a way to assign the categories only for the mails with attachment?
Diane Poremsky says
You can use an if statement - it should work after the move, if not, put it before the message is moved.
If Item.Attachments.Count > 0 Then
item.categories = "category name"
end if
Nravota says
Is there also a way to assign the rotating categories within a sub, so the user can decide when exactly the mails in the inbox should be categorized?
Diane Poremsky says
To run the macro manually? Sure - with a little tweaking, it can be used manually. I have a sample macro that works on all messages in a folder here: https://www.slipstick.com/developer/code-samples/working-items-folder-selected-items/ add the category code to it to apply categories to messages in a folder.
Paul H says
Hi Diane,
I'm basically brand new to VB and I'm trying to get the macro to run manually on selected mail objects in a shared mailbox. Can you expand on this a bit more?
I've tried copying the category code (starting with the "Dim strCat As String" line, ending with "If i = 5 Then i = 0 line") and pasting it over the Debug.Print .Subject line in the "Work with Selected items in any folder" code but I keep getting a variable not defined error where it highlights the i in Select Case i. What am I doing wrong?
Nravota says
Hi, this macro is great, but I have one question - will it assign color categories only in the Inbox folder of the non-default mailbox or it will also go in all folders in the non-default mailbox. For instance, I have inbox folder but I also have archives folder with many subfolders in the same mailbox. I do not want to change what is already there. I only want the macro to put rotating categories in the inbox folder.
Diane Poremsky says
It assigns categories to new messages as they arrive in the folder identified here:
GetFolderPath("Shared mailbox name\Inbox"). It won't touch other folders.
Abbas says
I did the same as mentioned above.It through an error as object variable or with block variable not set
Diane Poremsky says
That means you are using a variable name that is not set. What line does it stop on? Did you edit the code?