Lister dossier + date dernière modification (sans les sous-répertoire)

Salut le Forum !

J'aimerais concevoir une macro permettant de lister tout les dossiers ainsi que leur date de dernière modification présent dans un chemin, sans les sous-dossiers.

J'ai bien essayé d'adapter une macro à mon cas (qui liste aussi les sous-répertoire) mais étant donner que la procédure va ce balader dans les sous-dossiers, elle est extrêmement lente et plante Excel :

Sub ListFolder()
Dim racine As String, fs As Object, dossier_racine As Object
racine = "N:\Perso\Excel\"         'On indique le chemin ici
Range("A:K").ClearContents
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.GetFolder(racine)
ligne = 1
ListFolder_2 dossier_racine, 1
End Sub

Sub ListFolder_2(ByRef Dossier, ByVal niveau)
Dim d As Object
If Dossier.Name Like "201*" Then
'La ligne que je rajoute pour que sa colle à mon cas
'Si le nom du dossier ne commence pas par 201 alors c'est un dossier
'que je ne veux pas dans ma liste
'mais du coup la procédure va quand même se balade
'dans les sous-répertoire ce qui doit la rendre lente
    Cells(ligne, niveau) = Dossier.Name
    Cells(ligne, niveau + 1) = Dossier.DateLastModified
    ligne = ligne + 1
End If
For Each d In Dossier.SubFolders
    ListFolder_2 d, niveau + 1
Next
End Sub

Donc si un connaisseur en la matière pouvait m'aider à adapter cette macro pour qu'elle soit moins lente sa serait cool ;D

Merci d'avance !

Bonjour,

Pour éviter d'aller dans les sous-dossiers, il faut retirer l'appel récursif :

For Each d In Dossier.SubFolders
    ListFolder_2 d, niveau + 1
Next

Bonjour Steelson !

Merci pour ton retour

Mais du coup si je retire "l'appel récursif" ma procédure ne liste plus mes dossiers mais seulement le premier !

Je vais me renseigner sur l'appel récursif histoire de comprendre le code

Limite le niveau dans ce cas

For Each d In Dossier.SubFolders
    If niveau = 1 Then ListFolder_2 d, niveau + 1
Next

Dim niveau%, ligne%

Sub ListFolder()
Dim racine As String, fs As Object, dossier_racine As Object
    racine = "N:\Perso\Excel\"         'On indique le chemin ici
    Range("A:K").ClearContents
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = fs.GetFolder(racine)
    ligne = 1
    ListFolder_2 dossier_racine, 1
End Sub

Sub ListFolder_2(ByRef Dossier, ByVal niveau)
Dim d As Object
If Dossier.Name Like "201*" Then
'La ligne que je rajoute pour que sa colle à mon cas
'Si le nom du dossier ne commence pas par 201 alors c'est un dossier
'que je ne veux pas dans ma liste
'mais du coup la procédure va quand même se balade
'dans les sous-répertoire ce qui doit la rendre lente
    Cells(ligne, niveau) = Dossier.Name
    Cells(ligne, niveau + 1) = Dossier.DateLastModified
    ligne = ligne + 1
End If
For Each d In Dossier.SubFolders
    If niveau = 1 Then ListFolder_2 d, niveau + 1
Next
End Sub

ou plus simple

Dim niveau%, ligne%

Sub ListFolder()
Dim racine As String, fs As Object, dossier_racine As Object
    racine = "N:\Perso\Excel\"         'On indique le chemin ici
    Range("A1").CurrentRegion.ClearContents
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = fs.GetFolder(racine)
    ligne = 1
    ListFolder_recursif dossier_racine, 1
End Sub

Sub ListFolder_recursif(ByRef Dossier, ByVal niveau)
Dim d As Object
    Cells(ligne, niveau) = Dossier.Name
    Cells(ligne, niveau + 1) = Dossier.DateLastModified
    ligne = ligne + 1
    For Each d In Dossier.SubFolders
        ListFolder_recursif d, niveau + 1
    Next
End Sub

Super ! Sa fonctionne super bien <3

De mon côté j'ai essayé de comprendre ce qu'était une fonction récursive et j'ai rien compris XDDD

Va falloir que je me forme dessus !

Encore merci Steelson