find mail folder containing a string

[csirgli]

Hi all,

I have a little project to auto-organize my mails.

So thought about a VBA code (as an Outlook rule script) which could help me ,but I was not able to find any reference how to do it, not even the Outlook 2003 VBA Language Reference helped.

so upon a new mail arrives this script has to be executed, by outlook rule.

I have the part when the String(string) is generated, what to look for.

Now I need to find the mail folder in Personal Folders which is containing this String, and return with the reference of the folder usable with the Item.Move

If soumeone can help me, I would be happy :)

[JP2112]

Can you provide an example?

[csirgli]

Ok so a mail subject is looking like <something>1234567<something>

1: search if there is a 7 digit number in the subject - yes - extract the first hit from the left , no - do nothing
2: if there is an extracted number, search in the personal folders from a specific root folder (in the example it is the PF/cases) for a folder name which contains this extracted number (mail parameters unchanged)

Personal folder
-cases (search only within this)
--...
--1234566 -...
--1234567 -...
---1234556 -.. (a subfolder or an additional level)
--1234568 -...
--...
(the -s in this example showing the hierarchy tree, depth of the folder)

if available - Move the mail to the first folder in hit of the search (from the top)
if not - do nothing.

So for the first function, I have found some example how to use an REGEXP in outlook 2010, in the subject field which will be a great base for the it. (although had no time to test it)


Function CheckSubject(Subject As String, PatternToCheck As String)
Dim ObjRegExp As RegExp
Dim ObjMatch As Match

Set ObjRegExp = New RegExp
ObjRegExp.Pattern = PatternToCheck

If (ObjRegExp.Text(Subject) = True) Then
Set CheckSubject = True
End If

End Function (thx for noxee for it)

For the second search function I have not found any example how should a reculsive search look like in the folder tree of the outlook.

[JP2112]

Need an example of a matching subject that would trigger the email to be moved.

You need a recursive search function to find a folder that might be more than one level below a given folder. Something like this:

http://www.outlookcode.com/threads.aspx?forumid=2&messageid=7069

Here is the basic framework of some VBA code you could use. You would still need to parse the subject for the seven-digit number, and include the recursive function to find the correct folder. But this should get you started.

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.mailItem

If TypeName(item) = "MailItem" Then
Set msg = item

' is this a matching email?
If msg.Subject Like "*[A-Z,a-z,0-9]#######*[A-Z,a-z,0-9]" Then

' parse subject for seven digit number here
' how???

' do recursive search for folder here,
' then move message to that folder, i.e.
' msg.Move "folder-object"

End If

End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetItems(olNS As Outlook.NameSpace, folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetOutlookApp() As Outlook.Application
Set GetOutlookApp = Outlook.Application
End Function

This code would be placed in the ThisOutlookSession module in Outlook's VBA editor, then you would need to restart Outlook. After making any changes to event handlers, you also need to restart Outlook.

[csirgli]

For the regex search I have already copied an example from noxee, for the recursive folder search that is the hard nut.

[Crocus Crow]

Here is a complete solution. Put all this code in the ThisOutlookSession module. In the Outlook VBA project (in Tools - References), you must set a reference to Microsoft VBScript Regular Expressions 5.5, otherwise the code won't compile.

Option Explicit

Private WithEvents Items As Outlook.Items
Dim olNameSpace As Outlook.NameSpace


Private Sub Application_Startup()
Set olNameSpace = GetNS(GetOutlookApp)
Set Items = GetItems(olNameSpace, olFolderInbox)
End Sub


Private Sub Items_ItemAdd(ByVal olItem As Object)

Dim olEmail As mailItem
Dim olStartFolder As MAPIFolder
Dim olCaseFolder As MAPIFolder
Dim caseNumber As String

If TypeOf olItem Is Outlook.mailItem Then
Set olEmail = olItem

'Extract 7-digit case number from email subject

caseNumber = Get_Match(olEmail.subject, "(\d{7})")

If caseNumber <> "" Then

'Search for folder represented by the case number, starting at Personal Folders/Cases

Set olStartFolder = olNameSpace.Folders("Personal Folders").Folders("Cases")
Set olCaseFolder = Find_Folder(olStartFolder, caseNumber)

'If case number folder found, move this email to it

If Not olCaseFolder Is Nothing Then
olEmail.Move olCaseFolder
End If

End If
End If

End Sub

Private Function GetItems(olNS As Outlook.NameSpace, Folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(Folder).Items
End Function

Private Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function

Private Function GetOutlookApp() As Outlook.Application
Set GetOutlookApp = Outlook.Application
End Function


'Return the substring which matches the first capture group of a regular expression pattern

Private Function Get_Match(subject As String, pattern As String) As String

Dim Re As RegExp
Dim ReMatches As MatchCollection

Get_Match = ""

Set Re = New RegExp
Re.pattern = pattern
Set ReMatches = Re.Execute(subject)
If ReMatches.Count > 0 Then Get_Match = ReMatches(0)

End Function


'Search for an Outlook folder name recursively, starting at the specified folder. If found, return the folder as
'a MAPIfolder object, otherwise return Nothing

Public Function Find_Folder(olStartFolder As Outlook.MAPIFolder, findFolderName As String) As Outlook.MAPIFolder

Dim i As Integer
Dim thisFolder As MAPIFolder

Set Find_Folder = Nothing
i = 1
While Find_Folder Is Nothing And i <= olStartFolder.Folders.Count
Set thisFolder = olStartFolder.Folders(i)

'Debug.Print thisFolder.Name
If LCase(thisFolder.Name) = LCase(findFolderName) Then
Set Find_Folder = thisFolder
ElseIf thisFolder.Folders.Count > 0 Then
'Search subfolders
Set Find_Folder = Find_Folder(thisFolder, findFolderName)
End If

i = i + 1
Wend

End Function

[csirgli]

Found a nice source for the folder search on he net. I'm not yet allowed to post a link, but it is from the vbaoffice.net page. (examples)


And it is working also. tested it with outlook 2010.

A note:
At the Public function FindFolder

At line:
Set Folders = Application.Session.Folders
You can use the following to refine the search area, with the folder tree (\\personal folders - xxx\Folder1\Folderr2) or if you have the mailbox - see your folder tree in outlook - \\mailbox\inbox\FolderA)
Set Folders = Application.Session.Folders("personal folders - xxx").Folders("Folder1").Folders("Folder2").Folders Set Folders = Application.Session.Folders("mailbox").Folders("inbox").Folders("FolderA").Folders the .Folder at the end is important.

And the code:


Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Public Sub FindFolder()
Dim Name$
Dim Folders As Outlook.Folders

Set m_Folder = Nothing
m_Find = ""
m_Wildcard = False

Name = InputBox("Find Name:", "Search Folder")
If Len(Trim$(Name)) = 0 Then Exit Sub
m_Find = Name

m_Find = LCase$(m_Find)
m_Find = Replace(m_Find, "%", "*")
m_Wildcard = (InStr(m_Find, "*"))

Set Folders = Application.Session.Folders
LoopFolders Folders

If Not m_Folder Is Nothing Then
If MsgBox("Activate Folder: " & vbCrLf & m_Folder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = m_Folder
End If
Else
MsgBox "Not Found", vbInformation
End If
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders)
Dim F As Outlook.MAPIFolder
Dim Found As Boolean

For Each F In Folders
If m_Wildcard Then
Found = (LCase$(F.Name) Like m_Find)
Else
Found = (LCase$(F.Name) = m_Find)
End If

If Found Then
Set m_Folder = F
Exit For
Else
LoopFolders F.Folders
If Not m_Folder Is Nothing Then Exit For
End If
Next
End Sub


Now I have to get some free time to merge the parts together, creat some config files, and setup steps...

[csirgli]

Hi all,

I have tried out Crocus Crow's solution, and many aspects are working fine, except the find folder. It is always returning with nothing.

I have changed the "Personal folders" to "Personal Folder - xxxx" and removed the cases folder to get a simple situation - as it is in the folder tree for olStartFolder. (have even copy-paste the name not to mistype it)

I have used the


Set olStartFolder = olNameSpace.Folders("Personal Folder - xxxx")
Set olCaseFolder = Find_Folder(olStartFolder, caseNumber)

MsgBox ("case folder: " & vbCrLf & olCaseFolder.FolderPath)
To monitor the result in Sub Items_ItemAdd to see if the find folder is existing, and the compiler - even with a mail/folder I know existing - is saying that the FolderPath has no value. (no hit in the search?)

Spent 2 hours on finding why without success (but the VBA is still new for me so the same result will be a snapshot for you only), although as a MAPIFolder the olCaseFolder.FolderPath should have a value if it has a hit, right?

Do you have any idea?

I have tried to merge with the vbaoffice solution for finding folders, but I have got only to halfway, without a working solution under an hour - before I had to stop for now. Well I still have some long hours before me till it is done.