Capita, raramente ma capita, di avere bisogno di sapere, in VBA, il contenuto di una sottocartella in termini di:
“Quante e quali sottocartelle ci sono in una determinata cartella?”
Ho elaborato per me e per voi un agile snippet scritto in VBA nelle versioni Excel e Access. trovate il tutto nella sezione LAB-Download al numero 21.
E’ anche una buona occasione per dare un’occhiata rapida alle collezioni in VBA. A patto d’inserire nei riferimenti di Visual Basic “Microsoft Office Object Library“, altrimenti il codice non funzionerà:
Il concetto, semplificando, è il seguente: VBA, una volta caricata la libreria degli oggetti di Office, è in grado di utilizzare uno speciale oggetto che porta il nome di Folders al quale diamo da “leggere” una specifica cartella.
L’oggetto Folder Una volta istanziato, espone la collezione Folders (con la s finale) che contiene l’elenco delle sottocartelle. Una collezione è in qualche modo simile a un array, con notevoli differenze e pros & cons da considerare.
Riporto, per vostra comodità, sia il codice Access (nell’esempio è previsto l’utilizzo di una form! sia quello Excel. Il primo è Access, il secondo Excel
Sub ShowFolderList()
Dim FolderObj, FoldersCollection, Cartella, Collezione, NomeCartella, Conteggio, Percorso
Dim fileDialog As Office.fileDialog
'creo l'oggetto FolderObj per utilizzare FSO
Set FolderObj = CreateObject("Scripting.FileSystemObject")
'istanziamo l'oggetto applicazione per la selezione della cartella
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With Application.fileDialog(msoFileDialogFolderPicker)
.Title = "Scegli la cartella"
.Show
End With
'assegna la cartella selezionata alla variabile Percorso
Percorso = Application.fileDialog(msoFileDialogFolderPicker).SelectedItems(1)
' inserisce il percorso nella form
Form_Maschera1.Testo3.Value = Percorso
'specifica il percorso per la collezione ForderS
Set FoldersCollection = FolderObj.GetFolder(Percorso)
'Assegna nome alla collezione Forder della collezione FolderS
Set Collezione = FoldersCollection.subfolders
'ciclo per estrarre le sottocartelle dalla collezione Folder
For Each Cartella In Collezione
'accumula nella variabile nome cartella, riga per riga, le sottocartelle
NomeCartella = NomeCartella & Cartella.Name & vbCrLf
Conteggio = Conteggio + 1
Next Cartella
'cancella eventuali conttenuti precedenti ricerche
Form_Maschera1.Testo1.Value = ""
Form_Maschera1.Testo1.Value = NomeCartella
Form_Maschera1.Etichetta5.Caption = "Cartelle trovate: " & Conteggio
MsgBox "OK, lavoro ultimato"
End SubSub mysub()
Dim FolderObj, FoldersCollection, Cartella, Collezione, NomeCartella, Conteggio, Percorso
Dim fileDialog As Office.fileDialog
'creo l'oggetto FolderObj per utilizzare FSO
Set FolderObj = CreateObject("Scripting.FileSystemObject")
'istanziamo l'oggetto applicazione per la selezione della cartella
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
'cancella eventuali contenuti precedenti
Range("A2:D500").Clear
With Application.fileDialog(msoFileDialogFolderPicker)
.Title = "Scegli la cartella"
.Show
End With
'assegna la cartella selezionata alla variabile Percorso
Percorso = Application.fileDialog(msoFileDialogFolderPicker).SelectedItems(1)
' inserisce il percorso nel foglio
Sheets("Foglio1").Select
Range("D2").Select
ActiveCell.Value = Percorso
'specifica il percorso per la collezione ForderS
Set FoldersCollection = FolderObj.GetFolder(Percorso)
'Assegna nome alla collezione Forder della collezione FolderS
Set Collezione = FoldersCollection.subfolders
'ciclo per estrarre le sottocartelle dalla collezione Folder
For Each Cartella In Collezione
'assegna, riga dopo riga, il nome della sottocartella alla cella
Conteggio = Conteggio + 1
Cells(1 + Conteggio, 2).Select
ActiveCell.Value = Cartella.Name
Next Cartella
Range("C2").Select
ActiveCell.Value = Conteggio
MsgBox "OK, lavoro ultimato"
End Sub
Una volta compreso il funzionamento delle collezioni, è relativamente semplice utilizzare il medesimo codice per elencare, ad esempio, i file contenuti in una determinata cartella.
Se infatti al posto della variabile Cartella inserissimo al suo posto una variabile che denomineremo MyFile ,con poche sostituzioni potremmo ottenere il risultato desiderato. Riporto qui sotto il codice Excel come esempio. Ho inserito le 4 piccole modifiche (oltre alla sostituzione della variabile Cartella con Myfile nella DIM) incapsulate all’interno di commenti segnalati con una serie di “——–” ;)
Sub mysub()
Dim FolderObj, FoldersCollection, MyFile, Collezione, NomeCartella, Conteggio, Percorso
Dim fileDialog As Office.fileDialog
'creo l'oggetto FolderObj per utilizzare FSO
Set FolderObj = CreateObject("Scripting.FileSystemObject")
'istanziamo l'oggetto applicazione per la selezione della cartella
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
'cancella eventuali contenuti precedenti
Range("A2:D500").Clear
With Application.fileDialog(msoFileDialogFolderPicker)
.Title = "Scegli la cartella"
.Show
End With
'assegna la cartella selezionata alla variabile Percorso
Percorso = Application.fileDialog(msoFileDialogFolderPicker).SelectedItems(1)
' inserisce il percorso nel foglio
Sheets("Foglio1").Select
Range("D2").Select
ActiveCell.Value = Percorso
'specifica il percorso per la collezione ForderS
Set FoldersCollection = FolderObj.GetFolder(Percorso)
'Assegna nome alla collezione Files della collezione FolderS
'-------------prima modifica--------------
Set Collezione = FoldersCollection.Files
'-----------------------------------------
'ciclo per estrarre le sottocartelle dalla collezione Folder
'-----------seconda modifica---------------
For Each MyFile In Collezione
'------------------------------------------
'assegna, riga dopo riga, il nome della sottocartella alla cella
Conteggio = Conteggio + 1
Cells(1 + Conteggio, 2).Select
'----------terza modifica-------------------
ActiveCell.Value = MyFile.Name
'-------------------------------------------
'----------quarta modifica-------------------
Next MyFile
'--------------------------------------------
Range("C2").Select
ActiveCell.Value = Conteggio
MsgBox "OK, lavoro ultimato"
End Sub