Estoy organizando e-mail en Outlook 2016 y necesito crear 3 subcarpetas específicas en cada carpeta (tengo que hacer esto en más de 3000 carpetas). Tengo el código que me crea automáticamente estas 3 carpetas en cada carpeta de forma individual:
Public Sub CreateFolders()
Dim CurrentFolder As Outlook.MAPIFolder
Dim Subfolder As Outlook.MAPIFolder
Dim List As New VBA.Collection
Dim Folders As Outlook.Folders
Dim Item As Variant
List.Add Array("1", olFolderInbox)
List.Add Array("2", olFolderInbox)
List.Add Array("3", olFolderInbox)
Set CurrentFolder = Application.ActiveExplorer.CurrentFolder
Set Folders = CurrentFolder.Folders
For Each Item In List
Folders.Add Item(0), Item(1)
Next
End Sub
(Lo conseguí en https://www.computergaga.com/blog/loop-through-subfolders-using-filesystemobject/)
Lo que no soy capaz de hacer es conseguir que se creen estas tres carpetas de forma automática en todas las subcarpetas de un directorio. He intentado integrar un loop, pero no consigo que funcione. Acabo de empezar a programar y he estado buscando una solución, pero no encuentro nada específico para este problema.
Aprecio cualquier ayuda que podáis proporcionarme.