Lister les sous-dossiers d'un même niveau

Bonjour,

Je dispose d'une arborescence structurée comme telle : Bureau\Qualité\Fournisseur 1\XXXXXX\YYYYYY

Où XXXXXXX représente un sous-répertoire correspondant à un numéro de commande (plusieurs par fournisseur). XXXXXX est de format numérique

Et où YYYYYY représente un sous-répertoire correspondant à un numéro de réception (plusieurs par commande). YYYYYY est de format numérique.

Je souhaiterais récupérer dans une cellule (Par exemple : A1) le numéro du sous répertoire ayant le nom "YYYYYY" le plus grand, afin de l'incrémenter et de d'obtenir ainsi un nouveau numéro de réception inédit. La recherche de ce numéro de réception le plus grand doit se faire parmi tous les fournisseurs.

Pourriez-vous m'aider ? Merci !

Cordialement,

Kro 55

PS : Je dispose d'Excel 2007

Bonjour,

J'ai trouvé ce code, qui permet de lister des sous-dossiers d'un seul répertoire (ici Fournisseur1), mais j'ai un peu de mal à tout comprendre, et à l'adapter pour me lister toutes les réceptions YYYYYY.

Merci d'avance !

Kro 55

Option Explicit
Private oCollec As Collection  

Public Sub Macro1()  
Dim chemin As String  

    chemin = Bureau\Qualité\Fournisseur 1

    Set oCollec = New Collection  
    SearchAllFilesInFolders (chemin)  
    AfficheListe  
    Set oCollec = Nothing  

End Sub  

Private Sub SearchAllFilesInFolders(ByVal chemin As String)  

Dim fso As FileSystemObject  
Dim dossier As Folder  

    Set fso = New FileSystemObject  
    Set dossier = fso.GetFolder(chemin)  
    Call scanFolder(dossier)  

End Sub  

Private Sub scanFolder(ByVal dossier As Folder)  
Dim sousdossier As Folder  

    For Each sousdossier In dossier.SubFolders  
        oCollec.Add sousdossier  
    Next  

End Sub  

Private Sub AfficheListe()  
Dim i As Long  
Dim lig As Long  
Dim ws As Worksheet  

    Set ws = ThisWorkbook.Worksheets(1)  
    lig = 2  

    With ws  
        For i = 1 To oCollec.Count  
            .Range("A" & lig).Value = oCollec(i)  
            lig = lig + 1  
        Next i  
    End With  
End Sub

Bonjour,

quels sont les type des sous-dossier ?? (des dossier simple, pdf,.....)

en ce qui concerne votre code :

rempalcer déjà

chemin = Bureau\Qualité\Fournisseur 1 

par

chemin = "Bureau\Qualité\Fournisseur 1"

Merci pour la correction, effectivement ça marche un peu mieux

Ce sont des simples sous-dossiers, contenant des fichiers Excel, PDF, word, ainsi que d'autres répertoires.

L'arborescence est réalisée ainsi : Bureau\Qualité\Fournisseur 1\Commande 1\Réception 1\Coulée 1

si les différent méthode fonctionne (les 3 macros que vous avez poster) :

il vous reste plus qu'à faire un grosse boucle qui parcours et récupère tout les nom de fichier dans des tableau pour ensuite comparer les valeur ^^

Je vais tenter cette solution quand j'ai un peu de temps

Merci !

une petit code beaucoup plus simple à utiliser(à adapter) :

Sub test()

Application.ScreenUpdating = False
Dim myPath As String, myFolder As String

myPath = ThisWorkbook.Path
myFolder = Dir(myPath & "\*", vbDirectory)

c = 1
Do While myFolder <> ""

    If GetAttr(myPath & "\" & myFolder) = vbDirectory Then
        Cells(c, 2) = myFolder
        c = c + 1
    End If
    myFolder = Dir()

Loop

End Sub

source : https://vbaforexcel.wordpress.com/2013/09/06/lister-les-fichiers-et-sous-dossiers-dun-dossier/

Effectivement, c'est beaucoup plus court. Merci !

Par contre, J'ai sur la première ligne "." et sur la deuxième ".." et après le nom de mes sous-répertoires.

A quoi cela correspond ?

les "." et ".." sont les sous dossier qui ne sont pas de dossier (pdf, word, excel......) (information à vérifier) ^^

J'ai réussi à boucler en utilisant les macros que j'avais, voila l'extrait modifié :

Private Sub scanFolder(ByVal dossier As Folder)
Dim dFournisseur As Folder
Dim dPériode As Folder
Dim dCommande As Folder
Dim dRéception As Folder

    For Each dFournisseur In dossier.SubFolders
        For Each dPériode In dFournisseur.SubFolders
            For Each dCommande In dPériode.SubFolders
                For Each dRéception In dCommande.SubFolders
                    oCollec.Add dRéception
                Next
            Next
        Next
    Next

End Sub

Merci pour ton aide !

Kro