In this short article we will show you an example of a problem related with creating folders with a macro in Outlook. This will allow you to create folder and fill it with relevant emails.
Example
You receive emails that have a "word" in the title of the email in the format of issue-xxxx, where xxxx is a 4 digit number.
You create a mailbox folder called issues and what you 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.
Solution
File projects in their own subfolders:
- Searches subject for a M or Z project number (must be between 4-6 digits).
- Files them in a project subfolder (create folder if one does not exist).
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
Any more outlook questions? check out our forum!
Subject
Replies
Outlook
- Outlook vba create folder
- How to create folders in outlook
- Vba outlook create folder
- Outlook Macro - Creating folders [solved] > Forum - Programming
- Create folder in desktop with vba, if exist, ignore [solved] > Forum - Excel
- Vba create new workbook and paste data [solved] > Forum - Excel
- Macro to Create New Workbook and Copy Data at Each Change of X > Forum - Excel
- How to create folders in my files on samsung tablet > Guide
- Reset Outlook to default settings
- How to change your Outlook email address?
- How to refresh Outlook inbox automatically?
- How to stop receiving same email multiple times in Outlook?
- Recover Hotmail account: security questions, password, phone
- How to remove profile picture in Outlook?
- How to disable CTRL + Enter shortcut on Outlook
- Set up out of office in Outlook: Android/iOS app, desktop
- Change Outlook password: on iPhone, Android, desktop
- How to change back from Outlook to Hotmail?
- Rebuild the Index file on Outlook 2010
- Change language on Outlook: app, web
- How to sign in to Hotmail
- What to do when Outlook won't open
- How to disable deleted message recovery on Outlook?
- Outlook (Hotmail) account blocked or hacked
- How to configure a BSNL e-mail POP/SMTP settings in Outlook
- Turn off hardware graphics acceleration: Outlook, 2019
- Change Outlook keyboard shortcuts: Mac, Windows 10
- How to create a new Outlook account?
- Set up the Outlook app: on Android, iPhone
- How to delete Hotmail account?
- How to block attachments from unknown senders in Outlook
- Unable to connect to Hotmail
- Insert emoji in Outlook: email
- How to create an account in Outlook
- How to log in to Outlook
- How to backup emails in Outlook