Use a Macro to Assign Messages in a Shared Mailbox

Chia sẻ bởi:hands

★★★★★

‹ Reply or ReplyAll with Attachments Process messages received on a day of... ›

Quảng cáo

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.

cdn.slipstick.com/images/2014/outlook/round-robin1.png

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 [URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#getfolderpath']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 nameInbox").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.

[URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#categories']Assign Categories | [URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#folders']Move Messages to Folders
[URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#mailboxes']Move Messages to Other Mailboxes | [URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#forward']Forward Messages

[URL='www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/#categories']

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

cdn.slipstick.com/images/2014/outlook/file-to-folders.png

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, [URL='answers.microsoft.com/en-us/subject/forum/category/topic/f28ea808-86f2-4cdf-96df-2397bf19b18c']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 nameInbox").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 ContraryInbox"
     Case 1
          moveFolder = "Diane PoremskyInbox"
     Case 2
          moveFolder = "John SmithInbox"
     Case 3
          moveFolder = "Mark JacksonInbox"
     Case 4
          moveFolder = "Sue EllenInbox"
    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 [URL='www.slipstick.com/developer/how-to-use-outlooks-vba-editor/']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 [URL='www.slipstick.com/developer/how-to-use-outlooks-vba-editor/']How to use the VBA Editor
www.slipstick.com/developer/code-samples/use-macro-assign-messages-shared-mailbox/