Move Emails from Inbox to Folders Based on an Excel Sheet

[tomm]

Hi All,

I am relatively green in terms of VBA, and having looked at several links online, I cant seem to understand how to do this:

There is a central mailbox (standard inbox) to which emails are sent with a reference ID in the Subject line (eg ID 1234567890 or 123456789). There is an excel sheet (Call Centre Admin.xls) that contains all ID references in Column 1, as well as a corresponding Admin Agent in Column 3.

I want mail to be passively pushed into corresponding folders named after the Admin Agent assigned to that reference ID. Therefore, folders will contain emails specifically assigned to that Admin Agent.

Those emails in the mailbox that do not link directly to an agent (because the ref ID is incorrect etc), can be manually investigated.

I have investigated the use of rules, but I do not know how to build rules that look in an excel sheet, as the ref IDs and agents will change on a daily basis, so we will need to update the excel daily.

The other question is how this code can be inputted into an exchange server. This is a separate question, but if we can solve for both that would be spectacular!

I am currently on Office 2013.

Thanks again

Tom

[gmayor]

You can run a macro script from an outlook rule to process the messages as they arrive using worksheet data e.g.

Option Explicit

Sub DistributeMail(olItem As Outlook.MailItem)
Dim arr() As Variant
Dim iCols As Long
Dim sRefID As String
Dim sAgent As String
Dim sAgentID As String

    arr = xlFillArray("C:\Path\Call Centre Admin.xlsx", "Sheet1")
    For iCols = 0 To UBound(arr, 2)        ' Second array dimension is columns.
        sRefID = arr(0, iCols)
        sAgentID = arr(1, iCols)
        sAgent = arr(2, iCols)
        If InStr(1, olItem.Subject, sRefID) > 0 Then
            olItem.Move Session.GetDefaultFolder(olFolderInbox).folders(sAgent)
            Exit For
        End If
    Next iCols
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkBook As String, _
                             strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long

    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkBook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

This assumes that your user folders are sub-folders of Inbox i.e.

olItem.Move Session.GetDefaultFolder(olFolderInbox).folders(sAgent)

[tomm]

Hi Graham,

Thanks so much for this! I pasted this into "ThisOutlookSession", updated the path to the excel file and restarted Outlook. I then sent myself an email with "123456789" in the subject, to no avail.

Have I missed something? Is this the correct place to paste?

Do I need to have generated the Admin folders prior, or will this generate for me?

Apologies for confusion
Tom

[gmayor]

The code should go in a new ordinary module and not ThisOutlookSession.
You will need to change the path in the line

arr = xlFillArray("C:\Path\Call Centre Admin.xlsx", "Sheet1")

to reflect the location of the workbook.
The folders used must be pre-existing sub folders of Inbox for the code to work as it stands.
The macro script is called from a rule that examines all incoming messages (or particular incoming messages). You must create that rule.
You can test the macro with a selected message in Inbox using the following macro added into the same module

Sub TestMsg()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    DistributeMail olMsg
lbl_Exit:
    Exit Sub
End Sub

[tomm]

Hi Graham,

Thanks again for all your help. I updated the location of the file, as well as created the folders in the inbox.

I just wanted to ask how I would build a rule that would call the script:

"The macro script is called from a rule that examines all incoming messages (or particular incoming messages). You must create that rule.".

I also added TestMsg() to the existing module, but without the rule, it doesn't seem to do anything.

Thanks again and apologies for the confusion.
Tom

[gmayor]

To use TestMsg. Select an existing message in the inbox of a type that needs processing and run the macro. It does not require a rule for that.
As for creating rules - see https://support.office.com/en-za/art...7-a50704d66c59