Sub EnumerateFoldersInStores()

 

 Dim colStores As Outlook.Stores

 

 Dim oStore As Outlook.Store

 

 Dim oRoot As Outlook.Folder

 

 

 

 On Error Resume Next

 

 Set colStores = Application.Session.Stores

 

 For Each oStore In colStores

 

 Set oRoot = oStore.GetRootFolder

 

 Debug.Print (oRoot.FolderPath)

 

 EnumerateFolders oRoot

 

 Next

 

End Sub

 

 

 

Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder)

 

 Dim folders As Outlook.folders

 

 Dim Folder As Outlook.Folder

 

 Dim foldercount As Integer

 

 

 

 On Error Resume Next

 

 Set folders = oFolder.folders

 

 foldercount = folders.Count

 

 'Check if there are any folders below oFolder

 

 If foldercount Then

 

 For Each Folder In folders

 


If InStr(oRoot.FolderPath, "_0") > 0 Then

    Folder.Delete

    

 End If


 

 EnumerateFolders Folder

 

 Next

 

 End If

 

End Sub