Leggere e cercare file e cartelle in cartelle e sottocartelle

Non pensavo di parlare di questo argomento, ma le ultime vicende mi hanno indotto a a farlo.

In Excel XP ed Excel 2003 c'è la proprietà FileSearch che restituisce l'oggetto FileSearch. In questo oggetto sono contenuti tutti i files trovati, a partire da una determinata cartella del disco fisso fino a tutte le sottocartelle in essa contenuti.

Nell'esempio seguente viene eseguita la ricerca dei file con estensione "gif" (Ricerca) a partire dalla cartella "F:\Clip-Img\grafica web\gif animate" (Percorso). La ricerca viene eseguita anche il tutte le sottocartelle in essa contenuti.

Il nome del file può essere indicato

I files trovati vengono di seguito restituiti e visualizzati sul foglio di lavoro.

Sub Trova_con_FileSearch()
Dim R, Percorso, Ricerca
Percorso = "F:\Clip-Img\grafica web\gif animate"
Ricerca = "*.gif"
Columns("A:C").ClearContents
Range("A1") = Percorso
Range("B1") = Ricerca
With Application.FileSearch
.LookIn = Percorso
.SearchSubFolders = True
.Filename = Ricerca
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
Range("C1") = "sono stati trovati " & .FoundFiles.Count & " file(s)"
For R = 1 To .FoundFiles.Count
Cells(R + 2, 1) = .FoundFiles(R)
Next
Else
MsgBox "Nessun file trovato"
End If
End With
End Sub

Questo è un esempio di ciò che ho ottenuto con le istruzioni appena eseguite:

F:\Clip-Img\grafica web\gif animate\c-blue.gif
F:\Clip-Img\grafica web\gif animate\c-blue3.gif
F:\Clip-Img\grafica web\gif animate\c-brown.gif
F:\Clip-Img\grafica web\gif animate\c-gold.gif
F:\Clip-Img\grafica web\gif animate\c-gold1.gif
F:\Clip-Img\grafica web\gif animate\c-red3.gif
F:\Clip-Img\grafica web\gif animate\c.blackwh.gif
F:\Clip-Img\grafica web\gif animate\gl-blu2.gif
F:\Clip-Img\grafica web\gif animate\gl-viol.gif
F:\Clip-Img\grafica web\gif animate\angeli ate\1.gif
F:\Clip-Img\grafica web\gif animate\angeli ate\10.gif
F:\Clip-Img\grafica web\gif animate\angeli ate\11.gif
F:\Clip-Img\grafica web\gif animate\angeli ate\12.gif

 


Il problema

Purtroppo questa comoda proprietà è venuta a mancare in Excel 2007.

Qualsiasi altra funzione o proprietà usata in Excel 2007 restituisce sempre ciò che è contenuto in Percorso (la cartella o il disco in esame), senza scendere anche nelle sottocartelle delle eventuali cartelle contenute in Precorso.

Potremmo provare ad usare il FileSystemObject ed alcuni suoi metodi (SubFolders oppure Files) come nel seguente esempio:

Attenzione:

perchè la seguente routine funzioni, è bene aggiungere al progetto dal menù Strumenti ---> Riferimenti la libreria Microsoft Scripting Runtine.

Per mezzo di questa aggiunta è possibile lavorare con il FileSystemObject che consente di accedere ai file ed alle altre risorse della macchina (directory e dischi).

 

 

Sub CercaFile2()
Dim Fso As New FileSystemObject
Dim GF As Folder
Dim F1 As File, F2 As Folder
Dim R, Percorso, Ricerca
Percorso = "F:\Clip-Img\grafica web\gif animate"
Ricerca = "gif"
Columns("A:C").ClearContents
Range("A1") = Percorso
Range("B1") = Ricerca
Set GF = Fso.GetFolder(Percorso)
R = 2
For Each F1 In GF.Files
' equivalente a: CreateObject("Scripting.FileSystemObject").GetFolder(Percorso).Files
If InStr(1, F1.Name, Ricerca, vbTextCompare) Then
R = R + 1
Cells(R, 1) = F1.Name
End If
Next
R = 2
For Each F2 In GF.SubFolders
'equivalente a: CreateObject("Scripting.FileSystemObject").GetFolder(Percorso).SubFolders
R = R + 1
Cells(R, 2) = F2.Name
Next
Set Fso = Nothing
Set GF = Nothing
Set F1 = Nothing
Set F2 = Nothing
End Sub

In questa routine usiamo il metodo GetFolder che è un membro del FileSystemObject e che restituisce un oggetto folder e corrisponde ad una specifica cartella del disco fisso.

Al metodo GetFolder possiamo richiedere

Purtroppo per noi questo non è sufficiente per ottenere dalla routine quello che molto semplicemente abbiamo ottenuto con la proprietà FileSearch.

Sia con il SubFolders che con il Files si ottengono sempre e comunque le cartelle ed i files contenuti al primo livello della cartella in esame.

In una situazione come questa non si riuscirà a leggere il contenuto delle sottocartelle contenute nella cartella in esame. In questa situazione otterremo questi due elenchi:

le cartelle:

angeli ate
disney
gif_neve
natale

i files:

c-blue.gif
c-blue3.gif
c-brown.gif
c-gold.gif
c-gold1.gif
c-red3.gif
c.blackwh.gif
gl-blu2.gif
gl-viol.gif

 

Si potrebbe tentare con la funzione Dir, ma anche con questa i risultati non cambiano. Si ottengono sempre e comunque i files che si trovano alla radice della cartella in esame.

Vediamo anche l'esempio di questo codice:

Sub cercafile_con_Dir()
Dim Percorso, Ricerca, NomeFile
Dim R
Percorso = "F:\Clip-Img\grafica web\gif animate"
Ricerca = "gif"

R = 0
Range("A1").CurrentRegion.ClearContents
NomeFile = Dir$(Percorso & "\*." & Ricerca)
Do While NomeFile <> vbNullString
R = R + 1
Cells(R, 1) = Percorso & "\" & NomeFile
NomeFile = Dir$()
Loop
End Sub

'altra sub simile a questa

Sub LeggiConDir()
Dim Percorso As String
Dim Ricerca As String
Dim mioFile As String
Dim Riga As Integer
Percorso = "F:\Clip-Img\grafica web\gif animate\"
Ricerca = "gif"
Columns("A:C").ClearContents
Range("A1") = Percorso
Range("B1") = Ricerca
Riga = 2
mioFile = Dir(Percorso)
Do While mioFile <> ""
If Mid$(mioFile, InStrRev(mioFile, ".") + 1, Len(Ricerca)) = Ricerca Then
Riga = Riga + 1
Cells(Riga, 1) = mioFile
End If
mioFile = Dir
Loop
End Sub

Attenzione:

Per queste due routines non è necessario aggiungere al progetto la libreria Microsoft Scripting Runtine.

 

Questo è un esempio dei files trovati:

F:\Clip-Img\grafica web\gif animate\c-blue.gif
F:\Clip-Img\grafica web\gif animate\c-blue3.gif
F:\Clip-Img\grafica web\gif animate\c-brown.gif
F:\Clip-Img\grafica web\gif animate\c-gold.gif
F:\Clip-Img\grafica web\gif animate\c-gold1.gif
F:\Clip-Img\grafica web\gif animate\c-red3.gif
F:\Clip-Img\grafica web\gif animate\c.blackwh.gif
F:\Clip-Img\grafica web\gif animate\gl-blu2.gif
F:\Clip-Img\grafica web\gif animate\gl-viol.gif


La soluzione

Se in Excel 2007 non si può disporre delle funzionalità della proprietà FileSearch occorre creare una routine che dia gli stessi risultati e per fare questo la routine deve essere ricorsiva. Ossia, a partire dalla cartella in esame, occorre leggere in sequenza il contenuto delle prime sottocartelle per poi

 

Girando per il Web ho trovato questa:

Sub CercaFiles()
Dim Fso As New FileSystemObject
Dim NomeFile As String
Dim strArr() As String
Dim I As Long
Dim Percorso As String
Dim Ricerca As String
Percorso = "F:\Clip-Img\grafica web\gif animate"
Ricerca = "gif"
Columns("A:C").ClearContents
Range("A1") = Percorso
Range("B1") = Ricerca

NomeFile = Dir$(Percorso & "\*." & Ricerca)
Do While NomeFile <> vbNullString
I = I + 1
ReDim Preserve strArr(1 To I)
strArr(I) = Percorso & "\" & NomeFile
NomeFile = Dir$()
Loop
Call recurseSubFolders(Fso.GetFolder(Percorso), strArr(), I, Ricerca)
Set Fso = Nothing
If I > 0 Then
For I = 1 To UBound(strArr)
Cells(I + 2, 1) = strArr(I)
Next
End If
MsgBox UBound(strArr)
End Sub


Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef I As Long, _
ByRef searchTerm As String)
Dim SubFolder As Folder
Dim strName As String
For Each SubFolder In Folder.SubFolders
strName = Dir$(SubFolder.Path & "\*." & searchTerm)
Do While strName <> vbNullString
I = I + 1
ReDim Preserve strArr(1 To I)
strArr(I) = SubFolder.Path & "\" & strName ' percorso e nome del file trovato
' strArr(I) = strName ' questa istruzione se si vuole il solo nome del file trovato
strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), I, searchTerm)
Next
End Sub

Attenzione:

anche qui, perchè la routine funzioni, è bene aggiungere al progetto dal menù Strumenti ---> Riferimenti la libreria Microsoft Scripting Runtine.

 

Di queste due la routine principale è la Sub CercaFiles() mentre la Private Sub recurseSubFolders è la subroutine che esegue il lavoro ciclico che stavo cercando.

Ma questa routine merita un commento perchè i più volenterosi si ritrovino con le istruzioni che qui sopra si leggono.

 

Nella Sub CercaFiles()

Dopo le solite inizializzazioni si definiscono il percorso ed il tipo di file che si vuole cercare.

Con NomeFile = Dir$(Percorso & "\*." & Ricerca) si inizia la lettura di quel che è nella cartella indicata da Percorso e si trova l'eventuale primo file

Fatto questo si entra nel ciclo Do While NomeFile <> vbNullString per leggere gli altri elementi presenti nella stessa cartella e mettere i nomi trovati in una matrice fintanto non si giunge alla fine.

Con la Dim Fso As New FileSystemObject, dichiarata ad inizio della routine, abbiamo già una istanza aperta con il FileSystemObject quindi a questo punto possiamo recarci alla Private Sub recurseSubFolders con i riferimenti a:

- Call recurseSubFolders(Fso.GetFolder(Percorso), strArr(), I, Ricerca) -

Ritornando a questa routine dalla Private Sub recurseSubFolders ci limitiamo a scrivere sul foglio di Excel l'eventuale contenuto della matrice che dovrebbe contenere tutti i files trovati.

 

Nella Private Sub recurseSubFolders

Questa SubRoutine è stata costruita in modo che continua a girare e non torna alla routine principale fintanto non ha letto tutto il contenuto delle cartelle che le sono state inviate dalla principale e, se incontra altre sottocartelle, continua a leggere anche queste.

La tecnica usata è alquanto complessa e si basa sulla possibilità di uscire dal ciclo For ... Next per eseguirne altri non nuovi elementi per poi riprendere le istanze interrotte per continuare con le vecchie istanze.

Anche qui si fa uso sia della funzione Dir che della proprietà SubFolders dell'oggetto Folder, entrambi menbri del FileSystemObject.

 

Ho voluto regalare questa routine, che confesso non è frutto del mio lavoro, bensì di una mia tenace ricerca nel Web, a quanti si soffermeranno a leggermi.

Questa routine, così come è costruita, può sostituire, in Excel 2007, la FileSearch che è una proprietà di Application (Application.FileSearch).

 

Come al solito buon lavoro e, prossimamente, torneremo sull'argomento con un altro piccolo esperimento ancora nel tema.

 

Per una più facile consultazione allego il file che ho usato per questo lavoro: file da scaricare