Macro for moving all emails from subfolders ( recursive )

Never wondered how I can get this emails sorted when all are spread in different folders ?

Well… I’ve got a very nice macro that I have found last week ;

In order this to work you will need to activate macro execution in your outlook

ALT +F11 ( Access Macro design )
Alt +F5 ( Execute Macro )

Dim objTargetFolder As Outlook.folder
Sub BatchMoveEmailsFromSubfoldersToAnotherFolder()
Dim objSourceFolder As Outlook.folder
Dim objFolder As Outlook.folder
'Get the source folder whose subfolders to be processed
Set objSourceFolder = Application.Session.PickFolder
If Not (objSourceFolder Is Nothing) And objSourceFolder.DefaultItemType = olMailItem Then
If objSourceFolder.folders.count > 0 Then
'Select a target folder
Set objTargetFolder = Application.Session.PickFolder
If Not (objTargetFolder Is Nothing) Then
For Each objFolder In objSourceFolder.folders
Call ProcessFolders(objFolder)
MsgBox "Move Completed!", vbExclamation
End If
MsgBox "No subfolders!", vbExclamation
End If
End If
End Sub
Sub ProcessFolders(ByVal objFolder As Outlook.folder)
Dim i As Long
Dim objSubfolder As Outlook.folder
For i = objFolder.Items.count To 1 Step -1
'Move emails to the target folder
If objFolder.Items(i).Class = olMail Then
objFolder.Items(i).Move objTargetFolder
End If
'Process subfolders recursively
If objFolder.folders.count > 0 Then
For Each objSubfolder In objFolder.folders
Call ProcessFolders(objSubfolder)
End If
End Sub


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.