lister les repertoires et les sous repertoires

Question

Rober
Bonjour,
je voudrais avoir la liste des repertoires et sous repertoires a partir d'un chemin donne.
Pour cela j'ai ecris celamais je n'ai que les repertoires du 1er niveau et pas les sous repertoires.
POuvez vous m'aider SVP
Merci

MON CODE
<
 ""
<' on ne prend pas en compte les 2 répertoires . et ..
 "." And Repertoire <> ".." Then
<' vérifier que repertoire est un dossier.
<If (GetAttr(chemin & Repertoire) And vbDirectory) = <vbDirectory Then
<Print #1, chemin; Repertoire

<End If
<End If
<Repertoire = Dir
<DoEvents
<Loop
<Close #1

stefsoft · Answer

Ce qui faut que tu fasses c'est une fonction récursive, c'est à dire une fonction qui se réappelle en elle même
je regarde si je peux te faire quelquechose...

cs_DARKSIDIOUS · Answer

Va voir ma source nommée Defilement Copie dossier : j'y est mis une fonction récursive pour copier un répertoire et tout ses sous dossier. Je pense que c'est ce qu'il te faut ;-)

DarK Sidious

[Responsable de la rubrique API et responsable VB du site www.ProgOtoP.com]

pcpunch · Answer

Voila une fonction recursive qui liste les fichiers : Public Enum eREDIRECTION eREDIRECT_FICHIER eREDIRECT_TABLEAU End Enum Public Sub SCANNER_LE_DISQUE2(ByVal LE_REP_DE_DEPART As String, _ ByVal LA_REDIRECTION As eREDIRECTION, _ Optional ByVal LES_MASQUES As String = vbNullString, _ Optional ByRef LE_TABL_DE_SORTIE As Variant, _ Optional ByVal LE_NO_DE_FICHIER As Long = 1) On Error Resume Next 'Obligatoire pour ne pas être emmerdé par les fichier systèmes (jusqu'à autre solution...) Dim I, N As Long Dim LE_COMPTEUR As Long Dim LE_NOM_FICHIER As String Dim LE_TABL_DE_REP_FILS() As String Dim LE_SPLIT_EXT() As String 'Va permettre de récupérer l'extension d'un fichier LE_COMPTEUR = 0 LES_MASQUES = UCase(LES_MASQUES) LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbReadOnly) 'Fichiers sans attribut + Fichiers en lecture seule ... Do While LE_NOM_FICHIER <> "" LE_SPLIT_EXT = Split(UCase(LE_NOM_FICHIER), ".") 'On utilise Split plutôt qu'un Right$(,3) car l'extension peut ne pas compter 3 car ! LE_COMPTEUR LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) 0 Then DoEvents If InStr(1, LES_MASQUES, ";" & LE_SPLIT_EXT(UBound(LE_SPLIT_EXT)) & ";") = 0 Then Select Case LA_REDIRECTION Case eREDIRECT_FICHIER: Print #LE_NO_DE_FICHIER, LE_REP_DE_DEPART & LE_NOM_FICHIER Case eREDIRECT_TABLEAU: ReDim Preserve LE_TABL_DE_SORTIE(1 To 2, UBound(LE_TABL_DE_SORTIE, 2) + 1) As String LE_TABL_DE_SORTIE(1, UBound(LE_TABL_DE_SORTIE, 2)) = LE_REP_DE_DEPART LE_TABL_DE_SORTIE(2, UBound(LE_TABL_DE_SORTIE, 2)) = LE_NOM_FICHIER End Select End If LE_NOM_FICHIER = Dir 'Fichier Suivant Loop 'Cherche ts les répertoires "fils" LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbDirectory) 'Fichiers sans attribut + répertoires ... Do While LE_NOM_FICHIER <> "" LE_COMPTEUR LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) 0 Then DoEvents If LE_NOM_FICHIER <> "." And LE_NOM_FICHIER <> ".." Then 'On regarde si le fichier est un répertoire. Si tel est le cas, on mémorise son nom 'afin de scruter les sous répertoire de celui-ci par la suite... If (GetAttr(LE_REP_DE_DEPART & LE_NOM_FICHIER) And vbDirectory) = vbDirectory Then 'ATTENTION : Les fic systèmes nous foutent en erreur ! N = N + 1 ReDim Preserve LE_TABL_DE_REP_FILS(N) As String 'Mémorise le nom du répertoire LE_TABL_DE_REP_FILS(N) = LE_REP_DE_DEPART & LE_NOM_FICHIER End If End If LE_NOM_FICHIER Dir 'Fichier suivant dans la liste extraite par LE_NOM_FICHIER Dir(CurrentPath, vbDirectory) Loop 'Recense ts les fichiers des répertoires mémorisés => Va nous donner : 1. Une liste de fichiers ' 2. Une autre liste de sous-répertoire (éventuellement) For I = 1 To N SCANNER_LE_DISQUE2 LE_TABL_DE_REP_FILS(I) & "\", LA_REDIRECTION, LES_MASQUES, LE_TABL_DE_SORTIE, LE_NO_DE_FICHIER Next I End Sub Private Sub Command1_Click() Dim Dossier As String Dim A() As String Dim J ReDim A(1 To 2, 0) As String 'A faire avant d'appeler SCANNER_LE_DISQUE sous peine d'erreur ! Dossier = "c:\windows\" SCANNER_LE_DISQUE2 Dossier, eREDIRECT_TABLEAU, , A, 1 For J = LBound(A, 2) + 1 To UBound(A, 2) A(1, J) = Replace(A(1, J), Dossier, "") List1.AddItem Dossier & A(1, J) & A(2, J) List1.Refresh Next J End Sub Ps: le depart du dir se trouve dans la variable Dossier Il faut 1 bouton et un listbox

Lister les repertoires et les sous repertoires

3 réponses

Discussions similaires