Je cherche à récuperer la liste des dossiers d'une arborescence de l'explorateur Windows.
J'ai pas mal cherché sur l'aide VBA d'Access et Excel, mais je n'ai pas réussi.
Merci de votre aide.
Je cherche à récuperer la liste des dossiers d'une arborescence de l'explorateur Windows.
J'ai pas mal cherché sur l'aide VBA d'Access et Excel, mais je n'ai pas réussi.
Merci de votre aide.
Bonjour,
S'agit-il de dossiers présent dans une seule branche de ton arborescence ou s'agit-il de dossiers répartis entre différentes branches ?
S'ils sont tous dans la même branche, c'est ultra facile et peu cher...
Tu dis ...
Les dossiers recherchés sont tous dans le même dossier source.
Merci
Voilà donc :
Exemple :
Un bouton de commande Command1 et une listbox List1
Code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12 Private Sub Command1_Click() monrepprinc = "d:\monoutil\" 'mets ici TON répertoire contenant tes dossiers mesrepssub = Dir(monrepprinc, vbDirectory) Do While mesrepssub <> "" If mesrepssub <> "." And mesrepssub <> ".." Then If (GetAttr(monrepprinc & mesrepssub) And vbDirectory) = vbDirectory Then List1.AddItem mesrepssub End If End If mesrepssub = Dir Loop End Sub
C'est super.
Dernière question, pour les sous-dossiers, que dois-je rajouter?
ce à quoi tu as répondu :
Alors ?Les dossiers recherchés sont tous dans le même dossier source.
Merci
L'aspect est maintenant totalement différent et il te faut jouer avec la récursivité.
Mais moi, je m'arrête maintenant ici dans cette discussion-ci, telle qu'elle a été "définie" par toi.
Salut,
Ceci devrait t'aider.
http://vb.developpez.com/faq/?page=Fichiers#rep_sousrep
bonjour,
voici une version sans utiliser la référence "scripting runtime" mais seulement VBA.
Fonction principale :
Fonctions secondaires appelées par la fonction principale
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 Public Function GetSubDirs(ByVal sRacine As String, ByRef asDirs() As String) As Integer Dim i As Integer sRacine = Trim$(sRacine) If Len(sRacine) > 0 Then ReDim asDirs(0 To 0) If Right$(sRacine, 1) = "\" Then sRacine = Left$(sRacine, Len(sRacine) - 1) asDirs(0) = "\" Do While i <= UBound(asDirs) AddSubDirs sRacine, asDirs(i), asDirs i = i + 1 Loop If i > 1 Then TriTableau asDirs GetSubDirs = i - 1 End If End If End Function
Utilisation :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Private Sub AddSubDirs(ByVal sRacine As String, ByVal sSubDir As String, _ ByRef asDirs() As String) On Error GoTo errtag Dim sCurFileDir As String Dim iDims As Integer sRacine = sRacine & sSubDir iDims = UBound(asDirs) + 1 sCurFileDir = Dir(sRacine, vbDirectory) Do While sCurFileDir <> vbNullString If sCurFileDir <> "." And sCurFileDir <> ".." Then If (GetAttr(sRacine & sCurFileDir) And vbDirectory) = vbDirectory Then ReDim Preserve asDirs(0 To iDims) sCurFileDir = sSubDir & sCurFileDir asDirs(iDims) = sCurFileDir & "\" iDims = iDims + 1 End If End If sCurFileDir = Dir Loop Exit Sub errtag: Resume Next End Sub Private Sub TriTableau(ByRef asTab() As String) Dim i As Long, j As Long, lInc As Long, n As Long, lMin As Long Dim lLowerBound As Long, lUpperBound As Long Dim sRef As String lLowerBound = LBound(asTab) lUpperBound = UBound(asTab) n = lUpperBound - lLowerBound + 1 lInc = 1 While lInc < n lInc = lInc * 3 + 1 Wend While lInc > 1 lInc = lInc / 3 lMin = lInc + lLowerBound For i = lMin To lUpperBound j = i sRef = asTab(i) Do While sRef < asTab(j - lInc) asTab(j) = asTab(j - lInc) j = j - lInc If j < lMin Then Exit Do Loop asTab(j) = sRef Next i Wend End Sub
On obtient donc un tableau trié par ordre alphabétique des sous-répertoires qui peut servir pour alimenter un listbox par exemple.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8 Dim asDirs() As String Dim i As Integer, iNbSubDirs As Integer iNbSubDirs = GetSubDirs("C:\Documents and Settings\", asDirs) For i = 1 To UBound(asDirs) '1 pour ne pas afficher le premier élément inutile Debug.Print asDirs(i) Next i Debug.Print iNbSubDirs
Philippe
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager