Lister les sous-répertoires (et/ou sous-sous-répertoires) d'un répertoire racine

Commenter

Contenu du snippet 

Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const INVALID_HANDLE_VALUE = -1

Private Type WIN32_FIND_DATAW
  dwFileAttributes As Long
  ftCreationTime As Currency
  ftLastAccessTime As Currency
  ftLastWriteTime As Currency
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName(519) As Byte
  cAlternate(27) As Byte
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATAW) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATAW) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Function GetAllDirectory(ByVal DirectoryName As String, ByRef Directories() As String) As Long
  Dim fData As WIN32_FIND_DATAW
  Dim hSearch As Long
  Dim CurrentDirectory As Long
  Dim DirectoriesCount As Long
  Dim Directory As String

  ' Ajout du premier répertoire
  ReDim Directories(0)
  Directories(0) = DirectoryName
  If Not VBA.Right$(Directories(0), 1) = "\" Then Directories(0) = Directories(0) & "\"
  DirectoriesCount = 1

  While CurrentDirectory < DirectoriesCount ' Pour chaque répertoire trouvé
    hSearch = FindFirstFile(StrPtr(Directories(CurrentDirectory) & "*"), fData) ' On liste ses sous-répertoires
    If Not hSearch = INVALID_HANDLE_VALUE Then
      Do
        If (fData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
          Directory = fData.cFileName
          Directory = VBA.Left$(Directory, InStr(Directory, Chr$(0)) - 1)
          If Not Directory = "." And Not Directory = ".." Then
            ReDim Preserve Directories(DirectoriesCount)
            Directories(DirectoriesCount) = Directories(CurrentDirectory) & Directory & "\"
            DirectoriesCount = DirectoriesCount + 1
          End If
        End If
      Loop While FindNextFile(hSearch, fData)
      Call FindClose(hSearch)
    End If
    CurrentDirectory = CurrentDirectory + 1 ' Passe au répertoire suivant pour le listing
  Wend

  GetAllDirectory = DirectoriesCount
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (drikce06)