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