Arborescence d'un disque

Comment récupérer l'arborescence d'un disque ou d'un répertoire dans un classeur Excel ?

Cette fonction (code Microsoft) t'intéressera sans doute. Elle renvoie dans un objet Dictionary le nom et chemin complet des fichiers d'un répertoire (et si besoin de ses sous-répertoires). Il est possible ensuite, à partir des items du dictionnaire, de mettre en forme la sortie dans une feuille de calcul. (La fonction est accompagnée d'un exemple simple de renvoi des résultats).
'utilise un objet Dictionary pour récupérer la liste des fichiers 'd'un répertoire et, en option, de ses sous-répertoires
procédure exemple en fin de module

Function GetFiles(strPath As String, _          
dctDict As Scripting.Dictionary, _          
Optional blnRecursive As Boolean) As Boolean  
'David Shank, Microsoft Corporation  
' This procedure returns all the files in a directory into  
' a Dictionary object. If called recursively, it also returns 
 ' all files in subfolders.  
' La bibliothèque Microsoft Scripting Runtime 
 ' doit être coché dans Outils\Références...    
Dim fsoSysObj   As Scripting.FileSystemObject 
 Dim fdrFolder   As Scripting.Folder  
Dim fdrsubFolder  As Scripting.Folder 
 Dim filFile    As Scripting.File   
 ' Return new FileSystemObject. 
 Set fsoSysObj = New Scripting.FileSystemObject    
On Error Resume Next  
' Get folder.  Set fdrFolder = fsoSysObj.GetFolder(strPath) 
 If Err <> 0 Then   
' Incorrect path.   
GetFiles = False   GoTo GetFiles_End  
End If  
On Error GoTo 0    
' Loop through Files collection, adding to dictionary. 
 For Each filFile In fdrFolder.Files  
 'récupère nom et chemin complet   
dctDict.Add filFile.Path, filFile.Path  
Next filFile   
 ' If Recursive flag is true, call recursively. 
 If blnRecursive Then   For Each fdrsubFolder In fdrFolder.subFolders    
GetFiles fdrsubFolder.Path, dctDict, True   
Next fdrsubFolder
 End If
 
 ' Return True if no error occurred.
 GetFiles = True
 
 GetFiles_End
   Exit Function
 End Function

You can use the following procedure to test the GetFiles procedure. This procedure creates a new Dictionary object, passes it to the GetFiles procedure, then prints every file in the strDirPath directory and every file in any subdirectories to the immediate window.

sub TestGetFiles()
 ' Call to test GetFiles function.
 
 Dim dctDict As Scripting.Dictionary
 Dim varItem As Variant
 Dim strDirPath As String
 
 strDirPath = "D:\OfficeVBA\Modules"
 
 ' Create new dictionary.
 Set dctDict = New Scripting.Dictionary
 ' Call recursively, return files into Dictionary object.
 If GetFiles(strDirPath, dctDict, True) Then
  Sheets.Add
  'récupère directement le tableau des items du dictionaire
  'dans la colonne A de la nouvelle feuille
  Range("A1:A" & dctDict.Count).Value = _
    Application.Transpose(dctDict.Items)
 End If
 end sub

Auteur :

Mot clef associé à cette page :