Visualizzazione post con etichetta Microsoft Visual Basic Application Edition. Mostra tutti i post
Visualizzazione post con etichetta Microsoft Visual Basic Application Edition. Mostra tutti i post

mercoledì 19 gennaio 2022

MS Outlook: Macro per stampare un elenco di cartelle di un file di dati

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.
    VBA, Inserisci 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
    VBA, Modulo (codice)
    FIG 2 - VBA, Modulo (codice)

  • Per eseguire la macro cliccare sul tasto play (o premere F5), selezionare la cartella desiderata e premere OK
    Seleziona cartella
    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.
    Messaggio contenente l'elenco cartelle
    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