Ask a question »

Outlook - A macro to create folders

August 2015


[Outlook] A macro to create folders



Issue


I receive emails very frequently that have a "word" in the title of the email in the format of issue-xxxx, where xxxx is a 4 digit number. I have created a mailbox folder called issues. What I would like the macro to do is to find all emails with a string of the format issue-xxxx in the title and look for a folder under issues with that same name. If one is not found, then it should be created. The email should then be moved to that subfolder.

For example, suppose an email comes in with the word issue-1234. The macro, when run (hopefully via the toolbar), should find that email and check for a folder called issue-1234 under the issues folder and create it if it was not found. The email should then be moved to that issue-1234 folder.

I have not really done any macro programming in the past, so any help on how to get started would be appreciated. If you happen to have a macro that does this already, and want to share the code, that would be even better.

Solution



' File projects in their own subfolders
' Written by Bryce Pepper (bpepper@kcsouthern.com)
' Searches subject for a M or Z project number (must be between 4-6 digits)
' and files them in a project subfolder (create folder if one does not exist)
' added support for P & R projects 2009-03-03 B.Pepper
' added support for # to make Bill Z. happy 2009-03-04 B.Pepper


Here is the code:
Dim WithEvents objInboxItems As Outlook.Items  
Dim objDestinationFolder As Outlook.MAPIFolder  

Sub Application_Startup()  
Dim objNameSpace As Outlook.NameSpace  
Dim objInboxFolder As Outlook.MAPIFolder  

Set objNameSpace = Application.Session  
Set objInboxFolder = objNameSpace.GetDefaultFolder(olFolderInbox)  
Set objInboxItems = objInboxFolder.Items  
Set objDestinationFolder = objInboxFolder.Parent.Folders("Projects")  
End Sub  

' Run this code to stop your rule.  
Sub StopRule()  
Set objInboxItems = Nothing  
End Sub  

' This code is the actual rule.  
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)  
Dim objProjectFolder As Outlook.MAPIFolder  
Dim folderName As String  

Set objRegEx = CreateObject("VBScript.RegExp")  
objRegEx.Global = False  
' Search for email subjects that contains project number (M007439, Z6312)  
objRegEx.Pattern = "([M,Z,P,R,#]d{4,6})"  

Set colMatches = objRegEx.Execute(Item.Subject)  
If colMatches.Count > 0 Then  
For Each myMatch In colMatches  
If Left$(myMatch.Value, 1) = "#" Then  
folderName = "M" & Right$("00" & Mid$(myMatch.Value, 2), 6)  
Else  
folderName = Left$(myMatch.Value, 1) & Right$("00" & Mid$(myMatch.Value, 2), 6)  
End If  

If FolderExists(objDestinationFolder, folderName) Then  
Set objProjectFolder = objDestinationFolder.Folders(folderName)  
Else  
Set objProjectFolder = objDestinationFolder.Folders.Add(folderName)  
End If  
Item.Move objProjectFolder  
Next  
End If  

Set objProjectFolder = Nothing  
End Sub  

Function FolderExists(parentFolder As MAPIFolder, folderName As String)  
Dim tmpInbox As MAPIFolder  

On Error GoTo handleError  
' If the folder doesn't exist, there will be an error in the next  
' line. That error will cause the error handler to go to :handleError  
' and skip the True return value  

Set tmpInbox = parentFolder.Folders(folderName)  
FolderExists = True  
Exit Function  
handleError:  
FolderExists = False  
End Function

Note that


Thanks to Pepper for this tip on the forum.
For unlimited offline reading, you can download this article for free in PDF format:
Outlook-a-macro-to-create-folders.pdf

See also

In the same category

Published by aakai1056.
This document entitled « Outlook - A macro to create folders » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.