I want to process a set of mail (sub-)folders beginning from one which is selected E.G
The aim is to change the first few characters in the name of each one.
Sub sf_Rename_email_folders2()
Dim objPane As NavigationPane
Dim CurrentModule As NavigationModule
Dim lngCounter As Long
Dim ns As Outlook.Namespace
Dim fld As Outlook.MAPIFolder
Dim objUnknown As Object
Dim mail As Outlook.MailItem
Dim prop As Outlook.UserProperty
Set objPane = Application.ActiveExplorer.NavigationPane
Set CurrentModule = objPane.CurrentModule
Set ns = Application.GetNamespace("MAPI")
' Set fld = ns.GetDefaultFolder(olFolderInbox)
Set fld = ns.Selection 'Fails here
If CurrentModule.NavigationModuleType = olModuleMail Then
For Each objUnknown In fld.Items
lngCounter = lngCounter + 1
' If TypeOf objUnknown Is Folder Then 'Folder is my guess
' Debug.Print lngCounter
' Debug.Print objUnknown.Type
' Debug.Print objUnknown.Name
' End If
Next
End If
End Sub
The code will eventually find the date of the oldest email in each folder, sort the folder names by date and chose an index number based on a format "0000" to prefix each name.
However, first things first - I can't even cycle through the sub-folder names of the selected folder. The code is a mish-mash of bits I have copied but got nowhere.
If you want to capture the current folder and its subfolders:
Sub Tester()
Dim objMod As NavigationModule
Dim f As Folder, sf As Folder
Set objMod = Application.ActiveExplorer.NavigationPane.CurrentModule
If objMod.NavigationModuleType <> olModuleMail Then 'looking at mail?
MsgBox "First select a Mail folder"
Exit Sub
End If
Set f = Application.ActiveExplorer.CurrentFolder 'currently-selected folder
Debug.Print "Viewing folder: " & f.Name
For Each sf In f.Folders 'check each subfolder
Debug.Print " subfolder: " & sf.Name
Next sf
End Sub