Sub launchpad()
 
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
    On Error Resume Next
    
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set MyFolder = objNS.PickFolder
    Call ProcessFolder(MyFolder)
    Set objNS = Nothing
 
Set MyFolder = Nothing
Set olApp = Nothing
Set objNS = Nothing
 
End Sub
 
 
Sub ProcessFolder(StartFolder As MAPIFolder)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim mai As mailitem
    On Error Resume Next
'    MsgBox StartFolder.Path, , "testing"
    
    ' process all the items in this folder
'    For Each objItem In StartFolder.Items
'        If TypeName(objItem) = "MailItem" Then
'            Set mai = objItem
'        End If
'    Next
        
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder)
    Next
 
Set mai = Nothing
Set objFolder = Nothing
Set objItem = Nothing
End Sub