Solved

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

Posted on 2015-01-26
5
43 Views
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.
screenshot
Any help on this would be appreciated. Also, should you have additional questions, please let me know. Thanks again.
0
Comment
Question by:blkstrim
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
5 Comments
 
LVL 18

Expert Comment

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

Author Comment

by:blkstrim
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.
0
 
LVL 18

Accepted Solution

by:
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

ProcessNextEmail:
Next I ' Next email

MsgBox "Filing process completed."

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

ErrorTrap:
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

0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

729 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