Date de création : 29/01/2007 à 12:29:00 2 Commentaire(s)

violent_ken

Ce code permet d'énumérer les fichiers et les sous dossiers d'un dossier spécifié.
Option pour récupérer de manière récursive TOUS les fichiers/sous dossier d'un dossier, ou alors juste ceux contenus directement dans le dossier.

Note : ce morceau de code est TRES grandement inspiré d'un code de ShareVB. Mais de toutes façons, c'est toujours la même chose avec FindFirstFile, FindNextFile..etc.

Exemple d'utilisation :



Private Sub Command1_Click()
Dim sFiles() As String
Dim sFolders() As String
Dim x As Long

List1.Clear
List2.Clear

ReDim sFiles(0) 'évite l'erreur dans le For... Ubound(sFile()) si aucun fichier trouvé
EnumFiles "c:\", sFiles(), True, False 'énumère les fichiers
EnumFolders "c:\", sFolders(), True, False 'énumère les dossiers

For x = 1 To UBound(sFiles())
List1.AddItem sFiles(x)
Next x
For x = 1 To UBound(sFolders())
List2.AddItem sFolders(x)
Next x
End Sub

Option Explicit

'-------------------------------------------------------
'TYPES
'-------------------------------------------------------
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

'-------------------------------------------------------
'APIS
'-------------------------------------------------------
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

'-------------------------------------------------------
'CONSTANTES
'-------------------------------------------------------
Private Const FILE_ATTRIBUTE_DIRECTORY      As Long = &H10


'-------------------------------------------------------
'énumère les fichiers d'un dossier
'de 1 à Ubound
'-------------------------------------------------------
Public Sub EnumFiles(ByVal Directory As String, Files() As String, Optional Begin As Boolean = False, Optional SubFolder As Boolean = True)
'infos d'un fichier et handle d'énumération
Dim FileInfo As WIN32_FIND_DATA, hFind As Long
'limite de Files
Static ub As Long

    'si on commence la limite est 0, pas d'enregistrement dans le tableau
    If Begin = True Then ub = 0
   
    'ouvre le dossier pour récupérer la liste de ses fichiers
    hFind = FindFirstFile(Directory & "*", FileInfo)
    If hFind <> -1 Then
        'si le fichier est un dossier
        If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            'si ce n'est ni . ni ..
            If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then
                'on récupère la liste des fichiers de ce sous dossier
                EnumFiles Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Files, False
            End If
        'sinon on l'ajoute à la fin de la liste
        Else
            ub = ub + 1
            ReDim Preserve Files(ub)
            'chemin complet
            Files(ub) = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)
        End If
        'tant qu'il y a des fichiers dans le dossier en cours
        Do While FindNextFile(hFind, FileInfo)
            'on peut arrêter à tout moment
            DoEvents
           
            'si le fichier est un dossier
            If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                'si ce n'est ni . ni ..
                If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then
                    'on récupère la liste des fichiers de ce sous dossier
                    EnumFiles Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Files, False
                End If
            'sinon on l'ajoute à la fin de la liste
            Else
                ub = ub + 1
                ReDim Preserve Files(ub)
                'chemin complet
                Files(ub) = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)
            End If
        Loop
    End If
    'ferme l'énumèration
    FindClose hFind
End Sub

'-------------------------------------------------------
'énumère les sous dossiers d'un dossier
'de 1 à Ubound
'-------------------------------------------------------
Public Sub EnumFolders(ByVal Directory As String, Folders() As String, Optional Begin As Boolean = False, Optional SubFolder As Boolean = True)
'infos d'un fichier et handle d'énumération
Dim FileInfo As WIN32_FIND_DATA, hFind As Long, sDir As String
'limite de Files
Static ub As Long

    'si on commence la limite est 0, pas d'enregistrement dans le tableau
    If Begin = True Then ub = 0
   
    'ouvre le dossier pour récupérer la liste de ses fichiers
    hFind = FindFirstFile(Directory & "*", FileInfo)
    If hFind <> -1 Then
        'si le fichier est un dossier
        If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            'si ce n'est ni . ni ..
            If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then
                'on récupère la liste des fichiers de ce sous dossier
                EnumFolders Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Folders, False
            End If
        End If
        'tant qu'il y a des fichiers dans le dossier en cours
        Do While FindNextFile(hFind, FileInfo)
            'on peut arrêter à tout moment
            DoEvents
           
            'si le fichier est un dossier
            If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                'si ce n'est ni . ni ..
                If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then
                    'on récupère la liste des fichiers de ce sous dossier
                    EnumFolders Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Folders, False
                End If
                sDir = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)
                If Right$(sDir, 3) <> "\.." Then
                    ub = ub + 1
                    ReDim Preserve Folders(ub)
                    'chemin complet
                    Folders(ub) = sDir
                End If
            End If
        Loop
    End If
    'ferme l'énumèration
    FindClose hFind
End Sub

Vous devez être connecté pour pouvoir poster un commentaire.