Solved

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

Posted on 2015-01-26
5
26 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
  • 2
5 Comments
 
LVL 18

Expert Comment

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

757 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now