Lister les fichiers d'un répertoire dans une feuille Excel [A publier]

[AlainTech]

Suite à cette question, je me suis basé sur le contenu de cette discussion (merci à SilkyRoad) pour charger, dans une feuille Excel, le contenu d'un répertoire (avec les sous-répertoires).

La routine:

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
Option Explicit
 
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)
  ' adapté de Ole P Erlandsen
  ' necessite d'activer la reference Microsoft Scripting RunTime
  Static FSO As FileSystemObject
  Dim oSourceFolder As Scripting.Folder
  Dim oSubFolder As Scripting.Folder
  Dim oFile As Scripting.File
  Static wksDest As Worksheet
  Static iRow As Long
  Static bNotFirstTime As Boolean
 
  If Not bNotFirstTime Then
    Set wksDest = ActiveSheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    wksDest.Cells(1, 1) = "Parent folder"
    wksDest.Cells(1, 2) = "Full path"
    wksDest.Cells(1, 3) = "File name"
    wksDest.Cells(1, 4) = "Size"
    wksDest.Cells(1, 5) = "Type"
    wksDest.Cells(1, 6) = "Date created"
    wksDest.Cells(1, 7) = "Date last modified"
    wksDest.Cells(1, 8) = "Date last accessed"
    wksDest.Cells(1, 9) = "Attributes"
    wksDest.Cells(1, 10) = "Short path"
    wksDest.Cells(1, 11) = "Short name"
 
    iRow = 2
    bNotFirstTime = True
  End If
  Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    wksDest.Cells(iRow, 1) = oFile.ParentFolder.Path
    wksDest.Cells(iRow, 2) = oFile.Path
    wksDest.Cells(iRow, 3) = oFile.Name
    wksDest.Cells(iRow, 4) = oFile.Size
    wksDest.Cells(iRow, 5) = oFile.Type
    wksDest.Cells(iRow, 6) = oFile.DateCreated
    wksDest.Cells(iRow, 7) = oFile.DateLastModified
    wksDest.Cells(iRow, 8) = oFile.DateLastAccessed
    wksDest.Cells(iRow, 9) = oFile.Attributes
    wksDest.Cells(iRow, 10) = oFile.ShortPath
    wksDest.Cells(iRow, 11) = oFile.ShortName
 
    iRow = iRow + 1
  Next oFile
 
  For Each oSubFolder In oSourceFolder.SubFolders
    ' On peut mettre ici un traitement spécifique pour les dossiers
  Next oSubFolder
 
  If bIncludeSubfolders Then
    For Each oSubFolder In oSourceFolder.SubFolders
      ListFilesInFolder oSubFolder.Path, True
    Next oSubFolder
  End If
 
End Sub

Et son appel:

Code :

1
2
3
Private Sub test()
  ListFilesInFolder "D:\My Documents\Access", True
End Sub

Edit 17/01/2007 -> Petite modification du code. Dans la première version, je repartais de la ligne 2 à chaque entrée dans la fonction.

[ThierryAIM]

Envoyé par AlainTech

J'y reviendrai, sans doute, ajouter d'autres infos que le path.

Si tu y reviens, previens lorsque c'est finalisé, et j'intègre à la FAQ VBA

[AlainTech]

Comme promis:

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
Option Explicit
 
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)
  ' adapté de Ole P Erlandsen
  ' necessite d'activer la reference Microsoft Scripting RunTime
  Static FSO As FileSystemObject
  Dim oSourceFolder As Scripting.Folder
  Dim oSubFolder As Scripting.Folder
  Dim oFile As Scripting.File
  Static wksDest As Worksheet
  Static iRow As Long
  Static bNotFirstTime As Boolean
 
  If Not bNotFirstTime Then
    Set wksDest = ActiveSheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    wksDest.Cells(1, 1) = "Parent folder"
    wksDest.Cells(1, 2) = "Full path"
    wksDest.Cells(1, 3) = "File name"
    wksDest.Cells(1, 4) = "Size"
    wksDest.Cells(1, 5) = "Type"
    wksDest.Cells(1, 6) = "Date created"
    wksDest.Cells(1, 7) = "Date last modified"
    wksDest.Cells(1, 8) = "Date last accessed"
    wksDest.Cells(1, 9) = "Attributes"
    wksDest.Cells(1, 10) = "Short path"
    wksDest.Cells(1, 11) = "Short name"
 
    iRow = 2
    bNotFirstTime = True
  End If
  Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    wksDest.Cells(iRow, 1) = oFile.ParentFolder.Path
    wksDest.Cells(iRow, 2) = oFile.Path
    wksDest.Cells(iRow, 3) = oFile.Name
    wksDest.Cells(iRow, 4) = oFile.Size
    wksDest.Cells(iRow, 5) = oFile.Type
    wksDest.Cells(iRow, 6) = oFile.DateCreated
    wksDest.Cells(iRow, 7) = oFile.DateLastModified
    wksDest.Cells(iRow, 8) = oFile.DateLastAccessed
    wksDest.Cells(iRow, 9) = oFile.Attributes
    wksDest.Cells(iRow, 10) = oFile.ShortPath
    wksDest.Cells(iRow, 11) = oFile.ShortName
 
    iRow = iRow + 1
  Next oFile
 
  For Each oSubFolder In oSourceFolder.SubFolders
    ' On peut mettre ici un traitement spécifique pour les dossiers
  Next oSubFolder
 
  If bIncludeSubfolders Then
    For Each oSubFolder In oSourceFolder.SubFolders
      ListFilesInFolder oSubFolder.Path, True
    Next oSubFolder
  End If
 
End Sub

Je n'ai pas traité l'analyse des flags d'attributs.
Ca pourrait faire l'objet d'une autre source.

Edit --> j'ai recopié ce code dans le premier message