Récupérer noms de répertoires contenus dans un répertoire

Version imprimable

16/04/2009, 12h34
thomas.chretiennot

Récupérer noms de répertoires contenus dans un répertoire

Bonjour le forum,

Amis connaisseurs de vba...

Voilà, j'ai un répertoire "ABCD" qui contient de nombreux autres répertoires (plusieurs dizaines). J'aimerais écrire une macro excel qui parcourt ABCD et récupère et copie le nom de chaque dossier (et non fichier !) contenu dans ABCD, les uns en-dessous des autres, dans les cellules d'un classeur excel.

Si vous aveez une petite idée sur la question...

Merci d'avance !

Configuration:
Windows XP
Office 2003

Un peit tour par la faq, je pense que ca devrais te donner une piste, il te suffit de ne pas afficher les fichier affiche les infor des subfolders
(je ne peux pas ajouté de référence sur mon ordi du coup, je ne peux pas t'aider d'avantage)

Essaye de remplacer

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem

Par

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = SourceFolder.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=SourceFolder.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = SourceFolder.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = SourceFolder.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = SourceFolder.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = SourceFolder.ParentFolder
 
        i = i + 1

Bonjour,
Ca pourra peut-être t'aider.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub LireRepertoir()
'lire le répertoir et mettre les noms sous/répertoir dans une feuille excel
Dim fs, F, f1, sf
Dim Chemin As String
Dim Lig As Long
Dim FL1 As Worksheet
    Chemin = "D:\" 'adapter au répertoir où sont situés les dossiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.SubFolders
    Set FL1 = Workbooks("Classeur1").Sheets("Feuil1")
    For Each f1 In sf
        Lig = Lig + 1
        FL1.Cells(Lig, 1) = f1.Name
    Next
End Sub

A+

16/04/2009, 14h14
thomas.chretiennot

Merci beaucoup !

Merci à vous deux pour la rapidité de vos réponses !

Je n'ai essayé pour l'instant que la deuxième solution et elle fonctionne parfaitement !! Exactement le comportement que je souhaitais pour ma macro !

Merci encore...