Scan and move email messages to specific folders based on subject line information

Posted on 2015-01-26
Last Modified: 2016-05-31
Let me see if I can describe what I am looking for below.
We have a mailbox where all of our project related emails are being BCC'd. The folder is 'Project'.  We would like to find a way to scan all of the email that is within this folder and file it according to a project number in the subject line of the email. We are using a custom form to add the project number when the email is being sent out. An example subject line would be:
Austin Project One -R21334322. The project number starts with the letter "R".
Here is the kicker, we would like for it to not only scan and move the emails to the correct Project folder, but if the project number folder does not exist, we would like for the macro to create it and then move the emails related to it.
I know this may be difficult to understand clearly, so I will attach a screenshot.
Any help on this would be appreciated. Also, should you have additional questions, please let me know. Thanks again.
Question by:blkstrim
  • 2
LVL 18

Expert Comment

ID: 40572183
Do you want to file the emails in subfolders in the mailbox or a folder hierarchy within your Windows filesystem?

Author Comment

ID: 40572879
I would like to file them in subfolders in the mailbox. The idea would be that others could view them if we shared the folders out. So it would look something like this

Project (where the emails will come into originally)
      --> R21334341
      --> R22134432

Thanks. I should have been clear on that.
LVL 18

Accepted Solution

Simon earned 500 total points
ID: 40573382
This works for me in Outlook 2010.
Add the code to a module within Outlook and assign it to a button on the Developer tab of the ribbon, or run it directly from the VBE window for testing.

This is adapted from previously written code and has a few unused variables still in it.

It prompts you to pick a folder each time, but you can hard code it if preferred.
It displays a messagebox and skips the email if it finds more than one projectname string in the email subject
e.g. Subject "for multiple projects - R12345679 and R22345678"

Sub FileInSubfoldersByProjectName_REGEX()
Dim I As Long
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim olItem As Outlook.MailItem
Dim olMailItem As Outlook.MailItem
Dim oNewMailItem As Outlook.MailItem
Dim sFname As String
Dim sPath As String
Dim iMessages As Long
Dim olTestFolder As Outlook.Folder

On Error Resume Next
'Open Outlook

Set olApp = GetObject(, "Outlook.Application")

If Err = 429 Then
     'Outlook is closed so start Outlook

     Set olApp = CreateObject("Outlook.Application")
End If
Set olNs = olApp.GetNamespace("MAPI")

On Error GoTo ErrorTrap
'Locate the folder containing the unprocessed e-mail messages
'Set olFolder = olNs.Folders("Mailbox - ANYMAILBOX"). _

Set olFolder = olNs.PickFolder
If olFolder Is Nothing Then
    MsgBox "No folder was selected for processing.", vbOKOnly + vbInformation, "File Emails by project"
    GoTo CleanExit
End If

'Application.Visible = True
If MsgBox("Are you sure you want to file emails from: " & vbCrLf & vbCrLf & _
    olFolder.Name, vbYesNo + vbQuestion, "Extract Email Attachments") <> vbYes Then
        GoTo CleanExit
End If

If olFolder.Items.Count = 0 Then
    Err.Raise vbObjectError + 1000, "", "No items in folder"
End If

'Examine each message starting from the bottom of the list
For I = olFolder.Items.Count To 1 Step -1
     ' test for item type (this is due to non-email items that can inhabit an email folder in outlook)
     If olFolder.Items(I).Class <> olMail Then
        Debug.Print "Item " & olFolder.Items(I).Name & " being skipped as this is not a mail message."
        GoTo ProcessNextEmail
     End If
     Set olItem = olFolder.Items(I)
     Debug.Print "Subject:" & olItem.Subject

    Set rgx = CreateObject("vbscript.regexp")
    rgx.Pattern = "(R[0-9]{8,9})"
    rgx.Global = True
    Set matches = rgx.Execute(olItem.Subject)
    If matches.Count = 0 Then
        Debug.Print "No regex matches"
    ElseIf matches.Count = 1 Then
        matchedString = matches.Item(0) '.SubMatches.Item(0)
        Debug.Print matchedString
        On Error Resume Next
        Set olTestFolder = olFolder.Folders(matchedString)
        If Err.Description = "The attempted operation failed.  An object could not be found." Then
        On Error GoTo 0
        olFolder.Folders.Add matchedString
        End If
        olItem.Move olFolder.Folders(matchedString)
        On Error GoTo ErrorTrap
    ElseIf matches.Count > 1 Then
        MsgBox "Multiple regex matches for email subject line " & vbCrLf & vbCrLf & olItem.Subject & vbCrLf & vbCrLf & "Please edit subject or file manually", vbOKOnly + vbExclamation
    End If

Next I ' Next email

MsgBox "Filing process completed."

Set olItem = Nothing
Set olFolder = Nothing
Set olNs = Nothing
Set olApp = Nothing
Exit Sub

Debug.Print Err.Number & Err.Description
MsgBox "Runtime error: " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & _
        "Please keep this box displayed on your screen and contact your administrator.", vbOKOnly + vbCritical
Resume CleanExit

End Sub

Open in new window


Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

MS Outlook is a world-class email client application that is mainly used for e-communication globally.  In this article, we will discuss the basic idea about MS Outlook, its advanced features, and types of MS Outlook File formats.
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question