Parcourir dossiers - 1 niveau [VBA] Résolu

Question

Bonjour,

Je dois actuellement réaliser une macro qui va parcourir des dossier à la recherche de fichiers Excel. Ce que je recherche à faire donc est parcourir 1 seul niveau de sous-dossiers:

Tenant compte de l'arborescence suivante:

Dossier parent\Dossier enfant 1 (1er sous-dossier)

Dossier parent\Dossier enfant 2 (2e sous-dossier)\Dossier enfant 21 (1er sous-sous-dossier)

Dossier parent\Dossier enfant 3

etc...

La macro ne parcourrait que les dossiers enfants 1, 2, 3, etc... mais pas le 21!


Merci d'avance pour votre aide!


Configuration: Windows 7 / Safari 535.2

pijaku · Answer

Bonjour, 
1- tu as déjà un code ou un embryon de code que l'on pourrait consulter et modifier le cas échéant? 
2- Une piste envisageable : 
la différence entre un dossier, un sous dossier et un sous-sous dossier est le nombre de "\" dans le chemin d'accès. 
Peut être voir cette piste. 
En exemple : 
Dim NbreSlashRacine As Byte, NbreSlashEnfant As Byte 

NbreSlashRacine = UBound(Split("C:\Documents and Settings\Utilisateur001\Bureau", "\")) 

'---- ici ton code servant à parcourir--- 

'auquel tu ajoutes un test : "si le nombre de slash compris dans le chemin  
'du sous dossier actuel est supérieur à NbreSlash + 1 alors on ne traite pas 
NbreSlashEnfant = Ubound(Split(CheminActuel, "\")) 
If NbreSlashEnfant > NbreSlashRacine + 1 Then 
    'ici code "on ne fait rien" 
Else 
    'ici code on fait... 
End If
3- Il existe peut être une méthode VBA toute faite, mais je ne la connais pas...
Cordialement, 
Franck P

oliv_44 · Answer

Bonjour,

Voilà une solution à optimiser (passer par du ubound au lieu d'utiliser un tableau limité à 100 enregistrements par exemple)

Dim lstRep(100) As String
Dim i As Integer

Sub listeRepertoire()

i = 0
listeUnRepertoire "D:\temp\"

End Sub

Sub listeUnRepertoire(Racine As String)

Dim strRep As String
Dim intDeb As Integer
intDeb = i + 1
strRep = Dir(Racine, vbDirectory)
While (strRep <> "")

If (strRep <> ".") And (strRep <> "..") Then
If (GetAttr(Racine & strRep) And vbDirectory) <> 0 Then
i = i + 1
lstRep(i) = Racine & strRep
End If
End If

strRep = Dir
Wend
For intj = intDeb To i
listeUnRepertoire (lstRep(intj) & "\")
Next

End Sub

lermite222 · Answer

Bonjour tous,
Peut-être plus simple ?
Sub ListerFichiers()
Dim Rep, sRp, Obj, sRep, F1
Dim Chem As String
    Chem = "C:\Dossier parent\"
    Set Obj = CreateObject("Scripting.FileSystemObject")
    Set Rep = Obj.Getfolder(Chem)
    For Each sRep In Rep 'Les répertoires enfants 1,2 3 etc...
        'lire les fichiers excel qui sont dans chaque répertoires.
        For Each F1 In sRep
            If Right(F1.Name, 3) = "xls" Then 'à adapter à tes fichiers
            'ICI TU EN FAIT CE QUE TU VEUX,c'est un classeur
            'par exemple
            Workbook.Open (F1.Path & "\" & F1.Name)
            End If
        Next F1
    Next sRep
End Sub
J'ai pas tester, si erreur de syntaxe tu dis.
A+

lermite222 · Answer

Impossible de modifier mon poste précédant et j'ai été trop vite...
Rectification et cette fois j'ai tester.. !!
Sub ListerFichiers()
Dim Rep, F, Obj, sRep, F1, sf
Dim Chem As String
    Chem = "C:\Dossier parent\"
    Set Obj = CreateObject("Scripting.FileSystemObject")
    Set Rep = Obj.Getfolder(Chem)
    Set sRep = Rep.subfolders
    For Each sf In sRep 'Les répertoires enfants 1,2 3 etc...
    'Debug.Print sf.Path
        'lire les fichiers excel qui sont dans chaque répertoires.
        Set F = sf.Files
        For Each F1 In F
            If Right(F1.Name, 3) = "xls" Then 'à adapter à tes fichiers
            'ICI TU EN FAIT CE QUE TU VEUX,c'est un classeur
            'par exemple
            'Workbooks.Open (F1.Path )
            'Debug.Print F1.Path
            'Debug.Print F1.Name
            End If
        Next F1
    Next sf
    Set Obj = Nothing
    Set Rep = Nothing
    Set F = Nothing
End Sub

A+

lermite222 · Answer

Marche à suivre..
1°) Dans l'IDE (VBA) >> Affichage >> Fenêtre exécution
2°) Enlever les apostrophes qui sont devant les Debug....
3°) mettre le curseur sur... For Each sf In sRep
4°) Taper F9, cette ligne va se surligner en brun.
5°) Taper F5, Cette ligne va se surligner en jaune, le code est à l'arrêt sur cette ligne et dans la fenêtre du dessous le nom du répertoire sera écrit.
6°) A chaque appui sur F8 le code sera exécuter et passera à la ligne suivante en affichant ce qui se passe dans la fenêtre exécution.
Ça devrait t'aider à comprendre.
Ça s'appel du Pas à pas et permet, entre autre, de comprendre le code.
A+

Parcourir dossiers - 1 niveau [VBA]

5 réponses

Discussions similaires

Newsletters