vbaoutlookoutlook-2010

Win 10 Outlook 2010 VBA to process mail folders


I want to process a set of mail (sub-)folders beginning from one which is selected E.G

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

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.


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