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

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Juice
Membre impliqué
Membre impliqué
Messages : 1'141
Appréciations reçues : 102
Inscrit le : 28 novembre 2017
Version d'Excel : Microsoft Excel 2010

Message par Juice » 11 octobre 2018, 12:22

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 !
Dans l'incapacité de continuer à vous aidez sur vos fichiers, je vous prie de bien vouloir m'excuser et vous invite à ouvrir un nouveau sujet pour reprendre vos problèmes avec un membre actif du Forum.

En espérant revenir très vite :)
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'030
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 11 octobre 2018, 13:32

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

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Avatar du membre
Juice
Membre impliqué
Membre impliqué
Messages : 1'141
Appréciations reçues : 102
Inscrit le : 28 novembre 2017
Version d'Excel : Microsoft Excel 2010

Message par Juice » 11 octobre 2018, 14:04

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
Dans l'incapacité de continuer à vous aidez sur vos fichiers, je vous prie de bien vouloir m'excuser et vous invite à ouvrir un nouveau sujet pour reprendre vos problèmes avec un membre actif du Forum.

En espérant revenir très vite :)
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'030
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 11 octobre 2018, 16:23

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
1 membre du forum aime ce message.

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'030
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 11 octobre 2018, 16:29

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
1 membre du forum aime ce message.

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Avatar du membre
Juice
Membre impliqué
Membre impliqué
Messages : 1'141
Appréciations reçues : 102
Inscrit le : 28 novembre 2017
Version d'Excel : Microsoft Excel 2010

Message par Juice » 11 octobre 2018, 16:36

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 :)
Dans l'incapacité de continuer à vous aidez sur vos fichiers, je vous prie de bien vouloir m'excuser et vous invite à ouvrir un nouveau sujet pour reprendre vos problèmes avec un membre actif du Forum.

En espérant revenir très vite :)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message