‘VBA Visual Basic EXCEL

‘Changing a files created, modified and accessed times.
‘The following code demonstrations how to alter the three file date stamps (creation, last accessed and last modified).

Option Explicit

Private oCollec As Collection

Private Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type

Private Type SYSTEMTIME
Year As Integer
Month As Integer
DayOfWeek As Integer
Day As Integer
Hour As Integer
Minute As Integer
Second As Integer
Milliseconds As Integer
End Type

Private Declare Function CreateFile Lib « kernel32 » Alias « CreateFileA » (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileTime Lib « kernel32 » (ByVal hFile As Long, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Private Declare Function SystemTimeToFileTime Lib « kernel32 » (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib « kernel32 » (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib « kernel32 » (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long

‘Purpose : To modify file creation, last accessed and last modified time for a file
‘Inputs : sFileName The path and name of the file to alter.
‘ dFileDate The new file date.
‘ [bSetCreationTime] If True alters the file creation time.
‘ [bSetLastAccessedTime] If True alters the file last modified/accessed time.
‘ [bLastWriteTime] If True alters the file last write time.
‘Outputs : Returns True if succeeded in altering the file time.
‘Notes :
‘Revisions :

Function FileSetDate(ByVal sFileName As String, ByVal dFileDate As Date, Optional bSetCreationTime As Boolean = False, Optional bSetLastAccessedTime As Boolean = False, Optional bSetLastModified As Boolean = False) As Boolean
Const GENERIC_WRITE = &H40000000, OPEN_EXISTING = 3
Const FILE_SHARE_READ = &H1, FILE_SHARE_WRITE = &H2

Dim lhwndFile As Long
Dim tSystemTime As SYSTEMTIME
Dim tLocalTime As FILETIME, tFileTime As FILETIME

tSystemTime.Year = Year(dFileDate)
tSystemTime.Month = Month(dFileDate)
tSystemTime.Day = Day(dFileDate)
tSystemTime.DayOfWeek = Weekday(dFileDate) – 1
tSystemTime.Hour = Hour(dFileDate)
tSystemTime.Minute = Minute(dFileDate)
tSystemTime.Second = Second(dFileDate)
tSystemTime.Milliseconds = 0

‘Open the file to get the filehandle
lhwndFile = CreateFile(sFileName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lhwndFile Then
‘File opened
‘Convert system time to local time
SystemTimeToFileTime tSystemTime, tLocalTime
‘Convert local time to GMT
LocalFileTimeToFileTime tLocalTime, tFileTime
‘——-Change date/time property of the file
FileSetDate = True
If bSetCreationTime Then
FileSetDate = FileSetDate And CBool(SetFileTime(lhwndFile, tFileTime, 0&, 0&))
End If
If bSetLastAccessedTime Then
FileSetDate = FileSetDate And CBool(SetFileTime(lhwndFile, 0&, tFileTime, 0&))
End If
If bSetLastModified Then
FileSetDate = FileSetDate And CBool(SetFileTime(lhwndFile, 0&, 0&, tFileTime))
End If
‘Close the file handle
Call CloseHandle(lhwndFile)
End If
End Function

‘Demonstration routine
Sub Test()
‘Set the creation time
FileSetDate « C:\temp\Posters.html », Now, True
‘Set the last accessed time
FileSetDate « C:\temp\Posters.html », Now, , True
‘Set the last write time
FileSetDate « C:\temp\Posters.html », Now, , , True
End Sub

Public Sub Macro1()
Dim chemin As String

chemin = InputBox(« Entrez le chemin du répertoire », « Répertoire »)
‘chemin = « N:\GestionSousMandat\PTF_SOLDES\ »

Set oCollec = New Collection
SearchAllFilesInFolders (chemin)
AfficheListe
Set oCollec = Nothing

End Sub

Private Sub SearchAllFilesInFolders(ByVal chemin As String)

Dim fso As FileSystemObject
Dim dossier As Folder

Set fso = New FileSystemObject
Set dossier = fso.GetFolder(chemin)
Call scanFolder(dossier)

End Sub

Private Sub scanFolder(ByVal dossier As Folder)
Dim sousdossier As Folder
Dim fichier As File

For Each fichier In dossier.Files
oCollec.Add fichier
Next

For Each sousdossier In dossier.SubFolders
Call scanFolder(sousdossier)
Next

End Sub

Private Sub AfficheListe()
Dim i As Long
Dim lig As Long
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets(1)
lig = 2
ws.Columns(1).Clear

With ws
For i = 1 To oCollec.Count
.Range(« A » & lig).Value = oCollec(i)
FileSetDate oCollec(i), Now, , , True

lig = lig + 1
Next i
End With
End Sub