Elenco file cartelle e sottocartelle

Hai un problema con Excel?

Nuova discussione

Elenco file, cartelle e sottocartelle
di Angelix (utente non iscritto) data: 17/08/2016 10:41:11
Buongiorno a tutti.
Per un progetto devo riportare su excel la lista dei file presenti in una cartella e nelle relative sottocartelle. La macro sotto riportata, mi scrive l'elenco dei file presenti nella cartelle e nelle sottocartelle nella colonna A. Ora io vorrei aggiungere nella colonna A e B il nome delle relative sottocartelle (senza il percorso). Provo a spiegarmi meglio. Se ho un file salvato in "C:documentiscansioniprova.pdf", vorrei avere nella colonna A il nome del file ("prova"), nella colonna B il nome della prima sottocartella ("documenti"), nella colonna C il nome della successiva sottocartella ("scansioni").
Grazie in anticipo a tutti

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 = "C:documentiscansioniprova.pdf"
Ricerca = "*.*"
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

di Vecchio Frac data: 17/08/2016 10:52:06
E se hai più di due sottocartelle? continui con le colonne successive o no?
La domanda è: il codice deve essere generico o sai epr certo che hai solo due livelli di sottocartelle?
Comunque ragioniamo.
Hai in sostanza una stringa col nome di file e il percorso completo.
La stringa ha un carattere delimitatore di path (la barra "").
Hai scritto un codice abbastanza complesso (cura meglio l'indentazione però, altrimenti a leggerlo si fa fatica) quindi mi aspetto che tu sappia che esiste un modo per suddividere una stringa in base a un delimitatore. Conosci un'istruzione che ottiene una serie di sottostringhe prendendo un carattere come delimitatore? Come puoi, successivamente, implementare il problema?
di Angelix (utente non iscritto) data: 17/08/2016 11:18:44
Per il mio progetto so che ci sono solo due livelli di sottocartelle.
Il codice l'ho implementato guardando sulla rete in quanto non sono un grande esperto.
Ho trovato la funzione split. L'ho inserita nel codice come da macro sotto, funge ma mi stampa solo sulla colonna A la prima parte della stringa ("C:").
.... If I > 0 Then For I = 1 To UBound(strArr) Cells(I + 2, 1) = Split(strArr(I), "") Next ....

di Angelix (utente non iscritto) data: 17/08/2016 11:23:40
Per i due livelli.

....
If I > 0 Then
For I = 1 To UBound(strArr)
Cells(I + 2, 1) = Split(strArr(I), "", 2)
Next
....

di Angelix (utente non iscritto) data: 17/08/2016 12:00:01
ci sono riuscito. Grazie mille!

Sub CercaFiles()
Dim Fso As New FileSystemObject
Dim NomeFile As String
Dim strArr() As String
Dim I As Long
Dim y As Long
Dim colonna As Long
Dim Percorso As String
Dim Ricerca As String
Dim stringa() As String
Percorso = "I:ScansioniPaolaARCHIVIO ATTESTATI ALIMENTARISTI ! ! !"
Ricerca = "*.*"
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)
    stringa = Split(Right(strArr(I), Len(strArr(I)) - Len(Percorso)), "")
    colonna = 1
    For y = LBound(stringa) To UBound(stringa)
    If stringa(y) <> "" Then
    Cells(I + 2, colonna) = stringa(y)
    colonna = colonna + 1
    End If
    Next
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

di Vecchio Frac data: 17/08/2016 13:31:04
Sono tornato dal pranzo e ho visto il risultato.
Ottimo lavoro, bravo

A prima vista poi mi sembra che il codice si può semplificare... ma non azzardo tentativi senza avere l'intero progetto :)

di patel data: 17/08/2016 16:03:27
quale l'intero progetto ? la macro proposta funziona così comè è, però trovo dispersivo dividere l'elenco su tante colonne, specialmente se le sottocartelle sono molte.
Preferisco questa

Sub ListSubfoldersFiles() 
    Dim myDir As String, temp(), myList, myExtension As String
    Dim Rtn As Integer, msg As String
    myDir = "F:Documenti"
    myExtension = "*.*"
    myList = SearchFiles(myDir, myExtension, 0, temp())
    If Not IsError(myList) Then
        Cells(1).Resize(UBound(myList, 2), 2).Value = _
        Application.Transpose(myList)
    Else
        MsgBox "No file found"
    End If
End Sub

Private Function SearchFiles(myDir As String _
    , myFileName As String, n As Long, myList()) As Variant
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.getfolder(myDir).Files
        Select Case myFile.Attributes
        Case 2, 4, 6, 34
        Case Else
            If (Not myFile.Name Like "~$*") _
            * (myFile.Path & "" & myFile.Name <> ThisWorkbook.FullName) _
            * (UCase(myFile.Name) Like UCase("*" & myFileName)) Then
                n = n + 1
                ReDim Preserve myList(1 To 2, 1 To n)
                myList(1, n) = myDir
                myList(2, n) = myFile.Name
            End If
        End Select
    Next
    For Each myFolder In fso.getfolder(myDir).subfolders
            SearchFiles = SearchFiles(myFolder.Path, myFileName, _
            n, myList)
    Next
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

di Vecchio Frac data: 17/08/2016 20:19:57
@patel
cit. "specialmente se le sottocartelle sono molte"
---> Angelix riferisce che ha solo due livelli di sottocartelle.
Non ho voluto metter mano al suo codice perchè magari il progetto è più complesso e ce ne ha mostrato solo una parte.
Il tuo codice è più razionale (anche se è molto curioso l'uso della moltiplicazione invece dell'operatore logico And nel case else).
di Angelix (utente non iscritto) data: 17/08/2016 21:47:27
Si esatto @Vecchio Frac devo lavorare solo su due livelli. Ovviamente il progetto é più complesso ma per iniziare avevo bisogno di tale funzionalità. In poche parole ho un elenco di dati che varia di giorno in giorno. Periodicamente per ogni dato devo controllare se é presente il relativo file all'interno dell'archivio, se é all'interno della cartella corretta, più altri piccoli controlli.

Vuoi Approfondire?