vbaoutlook

Process mail folders and subfolders


02/06/2025 See update at the end of this question...

I want to process a set of mail (sub-)folders beginning from the one selected.

enter image description here

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

How can I cycle through the sub-folder names of the selected folder?

UPDATE

After working though @tim_williams reply I was able to rename some email sub-folders which have a parent "Shopping". Each sub-folder had a 3-digit index number prefix eg "123 Description" and I wanted to rename them to 4-digit prefix. The code below was a "run once" routine with the suggested check that I was renaming email folders.

Sub sf_Rename_email_folders3()

' Purpose : to Rename shopping email folders names by prefixing each one with a zero "0".
'           This extends the shopping index numbering to 9999 which I am unlikely to exceed.
'
' NOTE: this is expected to be a ONE-TIME-ONLY procedure - but you never know...
'
' Needs   : Current object group to be email and to have a folder selected. The folder must be in Home Situations
'           to prevent damaging the mail folder system.
'
' Activation  : by hand, once only.

  Dim objMod As NavigationModule
  Dim f0 As Folder, sf1 As Folder, sf2 As Folder
  Dim oItem As Object
  Dim oMail As Outlook.MailItem
  Dim Folder_save As Folder
  Dim SF_Is_0_9 As Boolean
  
' Just select the group requiring renaming. Don't get that wrong...
  Set objMod = Application.ActiveExplorer.NavigationPane.CurrentModule
  
' Ensure a mail folder is selected.
  If objMod.NavigationModuleType <> olModuleMail Then
     MsgBox "First select the parent email folder of the group to have indices prefixed with zero"
     Exit Sub
  End If

' Begin at the selected folder
  Set f0 = Application.ActiveExplorer.CurrentFolder
  
  Debug.Print "Processing folder: " & f0.Name
' Iterate through first group sub-folders
  For Each sf1 In f0.Folders  'check each subfolder
' * Until the end of list
    Debug.Print "   subfolder: " & sf1.Name & " contains..."
    
'   Iterate through the second list of folders
'   NB it's these folder names that need a new zero prefix
    For Each sf2 In sf1.Folders
'   * Until the end of list
'     Check that first character in name is 0-9
      SF_Is_0_9 = IsNumeric(Left(sf2.Name, 1))

      If SF_Is_0_9 Then
'     o Begins with 0-9
'       Prefix with zero
'        sf2.Name = "0" & sf2.Name 'commented out for safety. Use once only.
        Debug.Print sf2.Name
      Else
'     o Not 0-9
'       User message and stop processing
        MsgBox ("Fault: folder does not begin with 0-9: " & sf1.Name & Chr$(10) & sf2.Name)
      End If
      
    Next sf2
  Next sf1
  
  Debug.Print "End of Processing"
End Sub

Solution

  • 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