MacroFacili: Elenco file di una cartella

Questa macro consente di leggere tutti i file di una cartella, comprese le sottocartelle, e che corrispondono ad determinato filtro; utilizza la tecnica della ricorsività.

Restituisce un oggetto collection che è possibile utilizzare ad esempio con un ciclo For Each

Utilizzandola come nell'esempio qui sotto potremmo avere l'elenco di tutti i file Excel presenti sul desktop.

Sub test()
  Dim DirDaEsaminare As String

  DirDaEsaminare = "C:\Users\PCDesktop"
  Dim ElencoFile As New Collection
  ScanDir ElencoFile, DirDaEsaminare, "*.xls*", True

  Dim tFile As Variant
  For Each tFile In ElencoFile
    ...
  Next tFile
End Sub

La macro: prima fa una semplice scansione della cartella, poi legge l'elenco delle sottocartelle e per ognuna esegue ricorsivamente la procedura.

Public Function ScanDir(Files As Collection, Folder As String, FileSpec As String, _
                        WithSubfolders As Boolean)
  Folder = AddSlash(Folder)

  Dim Temp As String
  Temp = Dir(Folder & FileSpec)

  ' Aggiunge tutti i file presenti nella cartella
  Do While (Temp <> vbNullString)
    Files.Add Folder & Temp
    Temp = Dir
  Loop

  ' Analisi per le sottocartelle
  If (WithSubfolders) Then
    ' Crea prima la collection delle sottocartelle da analizare
    Dim SubFolders As New Collection
    Temp = Dir(Folder, vbDirectory)
    Do While (Temp <> vbNullString)
      If (Temp <> ".") And (Temp <> "..") Then
        If (GetAttr(Folder & Temp) And vbDirectory) <> 0 Then
          SubFolders.Add Temp
        End If
      End If
      Temp = Dir
    Loop

    ' per ogni sottocartella esegue la stessa funzione ricorsivamente
    Dim tFolder As Variant
    For Each tFolder In SubFolders
      Call ScanDir(Files, Folder & tFolder, FileSpec, True)
    Next tFolder
  End If
End Function

Questa parte è utilizzata solo per aggiungere uno slash (/) in fondo al nome della cartelle (se non è già presente):

Public Function AddSlash(Folder As String) As String
  AddSlash = Folder
  ' aggiunge uno slash solo se non presente
  If (Len(Folder) > 0) Then
    If (Right(Folder, 1) <> "/") Then
      AddSlash = AddSlash & "/"
    End If
  End If
End Function