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 Explicit
Option Base 1
Dim h As Integer
Dim Tableau2()
Sub listeDossiersEtSousDossiers()
Dim Racine As String, recentDir As String
Racine = "D:\Documents\Laurent\"
ListeSousRepertoires Racine, True 'recherche le repertoire le + récent
recentDir = triDecroissant(Tableau2())
Erase Tableau2
h = 0
listeFichiers_dateModification recentDir
MsgBox triDecroissant(Tableau2())
Erase Tableau2
h = 0
End Sub
Sub ListeSousRepertoires(SourceFolderName As String, _
IncludeSubfolders As Boolean) ' adapté de Ole P Erlandsen
Dim Fso As Object, SourceFolder As Object, SubFolder As Object
Dim RepItem As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)
h = h + 1
ReDim Preserve Tableau2(2, h)
Tableau2(1, h) = SourceFolder
Tableau2(2, h) = SourceFolder.DateLastModified
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subFolders
ListeSousRepertoires SubFolder.Path, IncludeSubfolders
Next SubFolder
End If
End Sub
Sub listeFichiers_dateModification(Chemin As String)
Dim Fichier As String
Dim Fso As Object, FileItem As Object
Fichier = Dir(Chemin & "\*.*")
Do
h = h + 1
ReDim Preserve Tableau2(2, h)
Set Fso = CreateObject("Scripting.FileSystemObject")
Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
Tableau2(1, h) = FileItem
Tableau2(2, h) = FileItem.DateLastModified 'lastmodified
Fichier = Dir
Loop Until Fichier = ""
End Sub
Function triDecroissant(Tableau()) As String
Dim i As Integer
Dim z As Byte, Valeur As Byte
Dim Cible As Variant
Do
Valeur = 0
For i = 1 To h - 1
If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
For z = 1 To 2
Cible = Tableau(z, i)
Tableau(z, i) = Tableau(z, i + 1)
Tableau(z, i + 1) = Cible
Next z
Valeur = 1
End If
Next i
Loop While Valeur = 1
'--- le plus récent ---
triDecroissant = Tableau(1, 1)
End Function |
Partager