Discussion :

[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 :

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
51
52
53
54
55
56
57
58
59
60
61
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 ' A adtapter
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With wksDest
      .Cells(1, 1) = "Parent folder"
      .Cells(1, 2) = "Full path"
      .Cells(1, 3) = "File name"
      .Cells(1, 4) = "Size"
      .Cells(1, 5) = "Type"
      .Cells(1, 6) = "Date created"
      .Cells(1, 7) = "Date last modified"
      .Cells(1, 8) = "Date last accessed"
      .Cells(1, 9) = "Attributes"
      .Cells(1, 10) = "Short path"
      .Cells(1, 11) = "Short name"
    End With
    iRow = 2
    bNotFirstTime = True
  End If
  Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    With wksDest
      .Cells(iRow, 1) = oFile.ParentFolder.Path
      .Cells(iRow, 2) = oFile.Path
      .Cells(iRow, 3) = oFile.Name
      .Cells(iRow, 4) = oFile.Size
      .Cells(iRow, 5) = oFile.Type
      .Cells(iRow, 6) = oFile.DateCreated
      .Cells(iRow, 7) = oFile.DateLastModified
      .Cells(iRow, 8) = oFile.DateLastAccessed
      .Cells(iRow, 9) = oFile.Attributes
      .Cells(iRow, 10) = oFile.ShortPath
      .Cells(iRow, 11) = oFile.ShortName
    End With
    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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.
Edit 16/03/2015 -> Optimisation: Utilisation de With - End With.

[ThierryAIM]

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 :

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
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

[flav_cm]

Bonjour AlainTech et merci pour la proposition de cette fonction !

Je souhaiterais savoir si certaines lignes pourraient particulièrement poser problème pour une recherche sur serveur (je n'avais jamais utilisé d'objet scripting...) ?

En effet ces lignes de codes fonctionnent parfaitement sur mon poste mais Excel plante dès que je tente de travailler sur un réseau...

Merci d'avance pour vos éléments.