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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
| Option Compare Database
' ---
' CONSTANTES
' ---
' Nom de la table et du champ
Public Const TABLE_FICHIERS = "tbl Fichiers"
Public Const CHAMP_FICHIER = "Fichier"
' ---
' LISTE DU CONTENU D'UN DOSSIER VERS UNE TABLE
' ---
'
Sub ListerFichiersRec( _
ByVal strDossier As String, _
Optional ByVal strExtension As String = "*.*", _
Optional blnViderTable As Boolean = False, _
Optional blnCheminComplet As Boolean = True)
' Variables
Dim rst As DAO.Recordset
' Vérifier que le dossier existe bien
strDossier = AddBackslash(strDossier)
If Dir(strDossier, vbDirectory) = "" Then
MsgBox "Dossier introuvable !", vbExclamation
Exit Sub
End If
' Vider la table si nécessaire
If blnViderTable Then
CurrentDb.Execute "DELETE FROM [" & TABLE_FICHIERS & "];"
End If
' Ouvrir la table
Set rst = CurrentDb.OpenRecordset(TABLE_FICHIERS, dbOpenDynaset)
' Déclencher le parcours récursif des fichiers
ListerFichiersRecDetail rst, strDossier, strExtension, blnCheminComplet
' On libère les ressources
rst.Close
Set rst = Nothing
End Sub
' ---
' PARCOURS RECURSIF DE DOSSIERS
' ---
'
Sub ListerFichiersRecDetail( _
rst As DAO.Recordset, _
ByVal strDossier As String, _
Optional ByVal strExtension As String = "*.*", _
Optional blnCheminComplet As Boolean = True)
' Quelques variables...
Dim strFichier As String
Dim varSousDossiers As Variant
Dim intI As Integer
' Lister tous les fichiers du dossier
DoEvents
strDossier = AddBackslash(strDossier)
strFichier = Dir(strDossier & strExtension, vbNormal)
While strFichier <> ""
' Stocker le nom du fichier dans la table
rst.AddNew
rst(CHAMP_FICHIER) = IIf(blnCheminComplet, _
strDossier & strFichier, _
strFichier)
rst.Update
' Lire le fichier suivant
strFichier = Dir
Wend
' Trouver les sous-dossiers éventuels
varSousDossiers = ListerSousDossiers(strDossier)
' S'il y a des sous-dossiers, les parcourir aussi récursivement
If (UBound(varSousDossiers) > 0) Then
' Traiter les sous-dossiers
For intI = 1 To UBound(varSousDossiers)
ListerFichiersRecDetail rst, varSousDossiers(intI), strExtension, blnCheminComplet
Next
End If
End Sub |
Partager