This Outlook macro creates subfolders under the currently selected folder.
To use, create an Excel file with the desired folder names in one column with a header row. The folder names will begin with row 2 (cell A2). You can create the file in Notepad and save it with the CSV extension.
Use Set objParentFolder = objNewFolder to create nested folders.
Option Explicit Public Sub MoveSelectedMessages() Dim objParentFolder As Outlook.Folder ' parent Dim newFolderName 'As String Dim strFilepath Dim xlApp As Object 'Excel.Application Dim xlWkb As Object ' As Workbook Dim xlSht As Object ' As Worksheet Dim rng As Object 'Range Set xlApp = CreateObject("Excel.Application") strFilepath = xlApp.GetOpenFilename If strFilepath = False Then xlApp.Quit Set xlApp = Nothing Exit Sub End If Set xlWkb = xlApp.Workbooks.Open(strFilepath) Set xlSht = xlWkb.Worksheets(1) Dim iRow As Integer iRow = 2 Set objParentFolder = Application.ActiveExplorer.CurrentFolder While xlSht.Cells(iRow, 1) <> "" newFolderName = xlSht.Cells(iRow, 1) On Error Resume Next Dim objNewFolder As Outlook.Folder Set objNewFolder = objParentFolder.Folders(newFolderName) If objNewFolder Is Nothing Then Set objNewFolder = objParentFolder.Folders.Add(newFolderName) End If iRow = iRow + 1 ' make new folder the parent ' Set objParentFolder = objNewFolder Set objNewFolder = Nothing Wend xlWkb.Close xlApp.Quit Set xlWkb = Nothing Set xlApp = Nothing Set objParentFolder = Nothing End Sub
Create subfolders at multiple levels
This code snippet uses the folder name in Column 1 to set the parent folder, with the new folder name in Column 2. Note that the parent folder needs to be the last one created (or the Inbox).
However, because the macro checks for the existence of the folder and creates it only if it doesn't exist, you can walk the folders to create deep subfolders. (Note: I never recommend deeply nested subfolders, it's too easy to forget where they are.)
A complete copy of this macro is here
'select starting parent Set objParentFolder = Application.ActiveExplorer.CurrentFolder Dim parentname While xlSht.Cells(iRow, 1) <> "" parentName = xlSht.Cells(iRow, 1) newFolderName = xlSht.Cells(iRow, 2) If parentName = "Inbox" Then Set objParentFolder = Session.GetDefaultFolder(olFolderInbox) Else Set objParentFolder = objParentFolder.Folders(parentName) End If On Error Resume Next Dim objNewFolder As Outlook.Folder Set objNewFolder = objParentFolder.Folders(newFolderName)
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor