In alcune circostanze può essere utile ottenere l'elenco delle sottocartelle presenti all'interno di un file di dati di Outlook. Di seguito viene mostrata una macro VBA adatta allo scopo. La macro ottiene un elenco dei nomi delle sottocartelle presenti in un file di dati a partire dalla cartella selezionata. L'elenco viene inserito in un nuovo messaggio pronto per essere inviato.
' strFoldersList è una stringa multiriga contenente i nomi delle cartelle
Public strFoldersList As String
' lCountFolders andrà a contenere il numero di cartelle elaborate
Public lCountFolders As Long
Public Sub GetFolderNames()
Dim olApp As Outlook.Application
Dim olSession As Outlook.NameSpace
Dim olStartFolder As Outlook.MAPIFolder
lCountFolders = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
'Consente all'utente di selezionare la cartella da cui iniziare la ricerca
Set olStartFolder = olSession.PickFolder
'Verifica se l'utente ha selezionato una cartella da cui partire
If Not (olStartFolder Is Nothing) Then
' Se è stata selezionata una cartella, avvia il processo di ricerca.
ProcessFolder olStartFolder
strFoldersList = strFoldersList & vbCrLf & "Totale cartelle elaborate:" & vbTab & lCountFolders
' Crea un nuovo messaggio email contenente l'elenco delle cartelle
Set ListFolders = Application.CreateItem(olMailItem)
ListFolders.Body = strFoldersList
ListFolders.Display
End If
' Resetta il contenuto della stringa per una nuova ricerca
strFoldersList = ""
End Sub
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
Dim lItemsInFolder As Long
lItemsInFolder = 0
' Esegue un loop sulle cartelle.
For i = 1 To CurrentFolder.Folders.Count
Set olTempFolder = CurrentFolder.Folders(i)
olTempFolderPath = olTempFolder.FolderPath
' Verifica il numero di elementi contenuti nella cartella
lItemsInFolder = olTempFolder.Items.Count
' Crea una stringa multiriga con i nomi delle cartelle.
' olTempFolder contiente il nome della cartella
strFoldersList = strFoldersList & vbCrLf & olTempFolderPath & vbTab & "(Items:" & lItemsInFolder & ")"
lCountFolders = lCountFolders + 1
Next
' Esegue la ricerca anche nelle sottocartelle della cartella corrente
For Each olNewFolder In CurrentFolder.Folders
ProcessFolder olNewFolder
Next
End Sub
La macro è molto semplice e i commenti consentono di capire come funziona. La procedura principale è GetFolderNames() che consente all'utente di selezionare la cartella su cui operare. Successivamente viene richiamata la procedura ProcessFolder che, partendo dalla cartella selezionata dall'utente, elabora tutte le sottocartelle.
Come utilizzare la macro
- Per utilizzare la macro avviare la finestra Microsoft Visual Basic, Application Edition premendo, dalla finestra principale di Outlook, la combinazione di tasti ALT+F11.
- Cliccare, con il tasto destro del mouse, su Progetto1 quindi cliccare su Inserisci e selezionare Modulo.
FIG 1 - VBA, Inserisci modulo - Copiare il codice sopra riportato e incollarlo nella nuova finestra. Per salvare il codice cliccare sull'icona del dischetto o premere la combinazione di tasti CTRL+S
FIG 2 - VBA, Modulo (codice) - Per eseguire la macro cliccare sul tasto play (o premere F5), selezionare la cartella desiderata e premere OK
FIG 3 - Seleziona cartella - Verrà creato un nuovo messaggio contenente l'elenco delle cartelle. Per ciascuna cartella verrà visualizzato il numero di elementi contenuti e, alla fine dell'elenco, verrà riportato il numero di cartelle elaborato.
FIG 4 - Messaggio contenente l'elenco cartelle
Visualizzare la dimensione di ciascuna cartella
Per visualizzare la dimensione di ciascuna cartella basta apportare una semplice modifica al codice della procedura ProcessFolder come mostrato di seguito. Apportando tale modifica bisogna considerare che il tempo di elaborazione della macro può aumentare notevolmente con l'aumentare delle cartelle e item da elaborare.
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
Dim lItemsInFolder As Long
Dim intSize As Long
Dim objItems As Items
Dim objItem As Object
lItemsInFolder = 0
' Esegue un loop sulle cartelle.
For i = 1 To CurrentFolder.Folders.Count
Set olTempFolder = CurrentFolder.Folders(i)
olTempFolderPath = olTempFolder.FolderPath
' Verifica il numero di elementi contenuti nella cartella
lItemsInFolder = olTempFolder.Items.Count
Set objItems = olTempFolder.Items
intSize = 0
' Somma la dimensione di ogni item presente nella cartella
For Each objItem In objItems
' Debug.Print olcount, objItem.Subject, objItem.Size
intSize = intSize + objItem.Size
Next
' Crea una stringa multiriga con i nomi delle cartelle.
' olTempFolder contiente il nome della cartella
strFoldersList = strFoldersList & vbCrLf & olTempFolderPath & vbTab & "(Items:" & lItemsInFolder & ") (Dimensione:" & Int(intSize / 1024) & " KB)"
lCountFolders = lCountFolders + 1
Next
' Esegue la ricerca anche nelle sottocartelle della cartella corrente
For Each olNewFolder In CurrentFolder.Folders
ProcessFolder olNewFolder
Next
End Sub
Esportare l'elenco in un file CSV
Se al posto di creare un nuovo messaggio di posta si intende salvare l'elenco delle cartelle all'interno di un file CSV modificare la procedura GetFolderNames() come indicato di seguito.
Public Sub GetFolderNames()
Dim olApp As Outlook.Application
Dim olSession As Outlook.NameSpace
Dim olStartFolder As Outlook.MAPIFolder
lCountFolders = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
'Consente all'utente di selezionare la cartella da cui iniziare la ricerca
Set olStartFolder = olSession.PickFolder
'Verifica se l'utente ha selezionato una cartella da cui partire
If Not (olStartFolder Is Nothing) Then
' Se è stata selezionata una cartella, avvia il processo di ricerca.
ProcessFolder olStartFolder
' Crea un file CSV nel percorso specificato
strPath = Environ("USERPROFILE") & "\Documents\ElencoCartelleOutlook.csv"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fileout = fso.CreateTextFile(strPath, True, False)
Fileout.WriteLine strFoldersList
End If
' Resetta il contenuto della stringa per una nuova ricerca
strFoldersList = ""
End Sub
