[XL-2007] gestion des folders [Résolu]

[Igloobel]

Bonjour à tous,

Je crée ce post car j'ai un petit soucis avec mon code VBA

Voilà je voudrais lister les noms des dossiers et sous-dossiers à partir d'un dossier spécifique (appellé également répertoires et sous-répertoires par les plus ancien d'entre nous )

exemple:
j'ai un dossier "Mon_Rep" (dossier spécifique)
"Mon_rep" contient le dossier "Titi" et "Toto" (sous-dossiers)
"Titi" contient "Tata" (sous-sous-dossier)
"Toto" contient "Tutu" qui contient "Tyty" (Sous-sous et sous-sous-sous-dossier)

Tous ces dossiers et sous-dossiers contienent des fichiers bien entendus

J'ai un code que voici :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Sub list_folder()
    'Liste les dossiers et sous dossiers
    Dim fs, f, f1, fc, s
    Le_Dossier = "c:\Mon_Rep\"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Le_Dossier)
    Set fc = f.SubFolders
    For Each f1 In fc
        s = s & f1.Name & vbCrLf
    Next
    MsgBox s
End Sub

Le problème est que je liste dans ma msgbox que les sous-dossiers et pas les autres (autrement dit que le premier niveau de sous-dossiers) or bien évidemment je veux tout comme si je faisais l'action TREE sous DOS

Quelqu'un pourait-il m'aider a optimiser ce code ou de me dire où trouvez la solution à mon problème.

J'ai utiliser frénétique F1 qui ma permit d'avoir ce code sans pouvoir allé plus loin, également été sur la FAQ Excel et les codes sources sans avoir trouvé

Merci d'avance à tous ceux qui m'aideront

[bbil]

Tiens :

http://vb.developpez.com/telecharger...-un-repertoire

c'est du VBS mais cela utilise"Scripting.FileSystemObject" mais c'est très facilement portable en VBA....

[Igloobel]

Merci bbil toujours aussi performant à ce que je vois.

Je teste aujourdhui et ce soir je dis (j'ai pas internet à mon boulot ) et sur mon Samsung c'est pas simple

[Theze]

Bonjour,

A adapter à tes besoins :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Dim Racine As Boolean
 
Sub Test()
 
    Dim Hierarchie As String
 
    Racine = True
 
    RecupDossiers "D:\MonDossier1\MonDossier2", Hierarchie
 
    MsgBox Hierarchie
 
End Sub
 
Private Sub RecupDossiers(Dossier As String, Retour As String)
 
    Dim Fso As Object
    Dim Dos As Object
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim Fichier As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    If Fso.FolderExists(Dossier) = False Then
 
        Retour = "Aucun sous-dossier !"
        Exit Sub
 
    End If
 
    'boucle sur les dossiers
    For Each Dos In Fso.GetFolder(Dossier).SubFolders
 
        'recherche les "\" afin de créer un décalage pour la hiérarchie
        For I = 1 To Len(Dossier) - 1
 
            If Mid(Dossier, I, 1) = "\" Then
                J = J + 1
            End If
 
        Next I
 
        'évite les décalages dû aux dossiers parents
        If Racine = True Then
 
            K = J
            Racine = False
 
        End If
 
        J = J - K
 
        'évite l'erreur des dossiers interdits
        On Error Resume Next
 
        'récupère le nom du dossier
        Retour = Retour & String(J * 4, "-") & Dos.Name & vbCrLf
 
        'Ici pour la récup des fichiers si nécessaire !!!
'''        For Each Fichier In Dos.Files
'''            Retour = Retour & String(J * 4 + 2, "-") & "->" & Fichier.Name & vbCrLf
'''        Next Fichier
 
        J = 0
 
        'rappel de la proc pour chercher les dossiers enfants
        RecupDossiers Dossier & "\" & Dos.Name, Retour
 
    Next Dos
 
End Sub

Hervé.

[Igloobel]

Merci à tout les deux pour votre aide précieuse.

Theze ton idée de "FolderExists" me plait bien il serait interessant de prévoir la création de dossier cible s'il n'existe pas !

Voici mon code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Dim stRepInital 'Nom du répertoire à parcourir
Public stRep, Tou_Rep_Trait As String
Public oFSO, oFld, oSubFolder
 
'==============================================
'Fonction récursive de parcours d'un répertoire
'==============================================
 
Sub ParcoursRepT()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    stRepInital = ThisWorkbook.Path 'lance à partir du repertoire ou il y a le code
    'Call stRecInit
    Call ParcoursRep(stRepInital)
    MsgBox Tou_Rep_Trait, vbInformation, "Copie des fichiers vers Mon_rep2"
End Sub
 
Sub ParcoursRep(ByVal stRep As String)
    Tou_Rep_Trait = Tou_Rep_Trait & "Traite : " & stRep & vbCrLf
    If oFSO.FolderExists(stRep) Then
    Set oFld = oFSO.GetFolder(stRep)
    If oFld.Files.Count > 0 Then Call copyfic
        If oFld.SubFolders.Count > 0 Then 'Teste le nombre de sous-répertoire dans stRep
            For Each oSubFolder In oFld.SubFolders
                ParcoursRep oSubFolder.Path 'appel récursif de la procédure
            Next
        Else
            If oFld.Files.Count > 0 Then 'Teste le nombre de fichier dans le sous-répertoire
                Call copyfic
            End If
        End If
    End If
End Sub
 
Sub copyfic()
    lieu_file = oFld.Path & "\*.txt"
    Set Fs = CreateObject("Scripting.FileSystemObject")
    Fs.CopyFile lieu_file, "c:\Mon_rep2\"
End Sub

Merci à toi Bbil car je me suis grandement inspirer de ton code car il correspond exactement à ce que je voulais.

Bien sur c'est optimisable à commencer par la verif de l'existance du repertoire par exemple

Ceci dis il est vrai que ce code aurais pu faire l'objet d'un script VBS mais je connais pas les objets system et sous l'invite de commande F1 euh ...

Voilà pourquoi je l'ai sous Excel mais pourquoi pas du VBS ! Alors dites moi c'est mieux VBA ou VBS ?

Igloobel

[Theze]

Bonjour,

Pour créer un dossier :

Code :

1
2
3
4
5
6
 
If Fso.FolderExists(Dossier) = False Then
 
    Fso.CreateFolder Dossier
 
End If

Hervé.

[Igloobel]

C'est Parfait

Grand merci à tous