Option Explicit
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
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 FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Cette fonction (d'Ivan F Moala) modifie la date/heure d'un Fichier. Entrées:
'CheminFichier > chemin complet du fichier
'sDate > "JJ-MM-AAAA" chaine contenant la date
'sTime > "HH:MM:SS" chaine heure(facultatif)
'Exemple d'appel (avec OK As Boolean)
'OK = FModifDateTimeFile("CheminComplet\Fichier.ext", "ChaineDate", "ChaineTime")
'If OK = True Then "Date modifiée OK !"
Public Function FModifDateTimeFile(CheminFichier As String, sDate As String, sTime As String) As Boolean
FModifDateTimeFile = False
On Error GoTo ExitFonction
'
Dim lFileHandle As Long, RetVal As Long, dDate As Date '< dDate ! entrée sDate !
Dim udtSystemTime As SYSTEMTIME, udtFileTime As FILETIME, udtLocalTime As FILETIME
'au format correct
dDate = Format(sDate & " " & sTime, "DD-MM-YYYY HH:MM:SS")
With udtSystemTime
.wYear = Year(dDate): .wMonth = Month(dDate): .wDay = Day(dDate)
.wDayOfWeek = Weekday(dDate) - 1
.wHour = Hour(dDate): .wMinute = Minute(dDate): .wSecond = Second(dDate)
.wMilliseconds = 0
End With
'Convertir l'heure système à l'heure locale
SystemTimeToFileTime udtSystemTime, udtLocalTime
'Convertir l'heure locale à l'heure GMT (UTC Temps Universel Coordonné)
LocalFileTimeToFileTime udtLocalTime, udtFileTime
'Ouvrir le fichier pour lire/écrire et obtenir le descripteur de fichier
lFileHandle = CreateFile(CheminFichier, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
'avons nous un handle fichier
If lFileHandle = 0 Then FModifDateTimeFile = False: GoTo ExitFonction
'Modifier la date/heure du fichier
RetVal = SetFileTime(lFileHandle, udtFileTime, udtFileTime, udtFileTime)
'est ce bien changé !?
If RetVal = 0 Then FModifDateTimeFile = False: GoTo ExitFonction
FModifDateTimeFile = True
ExitFonction: 'fin ou quitte (close handle fichier)
If lFileHandle Then CloseHandle lFileHandle
End Function
'pour véfifier si nécessaire un Format "DD-MM-YYYY" et "HH:MM:SS"
Private Function VerifyDateTime(DateTest As String, TimeTest As String) As Boolean
Dim HH As Single
On Error Resume Next: Err.Clear
If DateTest > "" Then
If Len(DateTest) <> 10 Then VerifyDateTime = False: Exit Function
If Not IsDate(CVDate(DateTest)) Then VerifyDateTime = False: Exit Function Else VerifyDateTime = True
ElseIf TimeTest > "" Then
If Len(TimeTest) <> 8 Then VerifyDateTime = False: Exit Function
HH = TimeValue(TimeTest): If Err Then VerifyDateTime = False: Exit Function Else VerifyDateTime = True
End If
On Error GoTo 0: Err.Clear
End Function
