Il est possible de changer la date et l'heure d'un fichier grâce à un bout de code en VBA
Code pour changer la date d'un fichier
Il suffit de copier le code suivant et d'adapter la procédure LancementTraitement à vos besoins
Option Explicit Public Const OFS_MAXPATHNAME = 260 Type OFSTRUCT cBytes As Byte fFixedDisk As Byte nErrCode As Integer Reserved1 As Integer Reserved2 As Integer szPathName(OFS_MAXPATHNAME) As Byte End Type Type FILETIME dwLowDate As Long dwHighDate As Long End Type Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMillisecs As Integer End Type ' constante Public Const FILE_SHARE_READ = &H1 Public Const FILE_SHARE_WRITE = &H2 Public Const GENERIC_WRITE = &H40000000 Public Const OPEN_EXISTING = 3 ' declarations api ' L'option PtrSafe a été ajouté pour gérer la compatibilité 32 bits / 64 bits #If VBA7 Then Declare PtrSafe 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 Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" _ (lpLocalFileTime As FILETIME, _ lpFileTime As FILETIME) As Long Declare PtrSafe Function SetFileTime Lib "kernel32" _ (ByVal hFile As Long, _ lpcreation As FILETIME, _ lpLecture As FILETIME, _ lpLastWriteTime As FILETIME) As Long Declare PtrSafe Function GetFileTime Lib "kernel32" _ (ByVal hFile As Long, lpCreationTime As FILETIME, _ lpLastAccessTime As FILETIME, _ lpLastWriteTime As FILETIME) As Long Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME, _ lpFileTime As FILETIME) As Long Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" _ (lpFileTime As FILETIME, _ lpSystemTime As SYSTEMTIME) As Long #Else 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 Declare Function LocalFileTimeToFileTime Lib "kernel32" _ (lpLocalFileTime As FILETIME, _ lpFileTime As FILETIME) As Long Declare Function SetFileTime Lib "kernel32" _ (ByVal hFile As Long, _ lpcreation As FILETIME, _ lpLecture As FILETIME, _ lpLastWriteTime As FILETIME) As Long Declare Function GetFileTime Lib "kernel32" _ (ByVal hFile As Long, lpCreationTime As FILETIME, _ lpLastAccessTime As FILETIME, _ lpLastWriteTime As FILETIME) As Long Declare Function SystemTimeToFileTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME, _ lpFileTime As FILETIME) As Long Declare Function FileTimeToSystemTime Lib "kernel32" _ (lpFileTime As FILETIME, _ lpSystemTime As SYSTEMTIME) As Long #End If
Public Function GetFT(sDate) As FILETIME Dim udtSysTime As SYSTEMTIME Dim udtLocalTime As FILETIME Dim Ft As FILETIME Dim RetVal As Long With udtSysTime .wYear = Year(sDate) .wMonth = Month(sDate) .wDay = Day(sDate) .wDayOfWeek = Weekday(sDate) - 1 .wHour = Hour(sDate) .wMinute = Minute(sDate) .wSecond = Second(sDate) End With RetVal = SystemTimeToFileTime(udtSysTime, udtLocalTime) RetVal = LocalFileTimeToFileTime(udtLocalTime, GetFT) End Function Public Function GetFileDateString(CT As FILETIME, sFormat As String) As String Dim ST As SYSTEMTIME Dim ds As Single 'Convertir les infos du fichier en un format temps affichable If FileTimeToSystemTime(CT, ST) Then ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay) GetFileDateString = Format$(ds, sFormat) Else GetFileDateString = "" End If End Function ' *********** Exemple d'appel pour changer la date de création du fichier ********* Public Sub LancementTraitement() ' Appel pour changer la date de modification Call ModifDate("C:\Users\frederic\OneDrive\Documents\Classeur1.xlsx", "21/07/2020 18:01:45", 3) ' Appel pour changer la date de création Call ModifDate("C:\Users\frederic\OneDrive\Documents\Classeur1.xlsx", "21/12/2019 18:01:45", 1) End Sub
'******** MODIFIER UN FICHIER *********************** Public Sub ModifDate(sNomFichier As String, sDate As String, byType As Byte) 'byType = 1 =>Date de creation 'byType = 2 =>Date de Lecture 'byType = 3 =>Date derniere ecriture 'byType = 4 => toutes Dim hFile As Long Dim Ft As FILETIME Dim FTc As FILETIME Dim FTa As FILETIME Dim FTw As FILETIME Dim RetVal As String hFile = CreateFile(sNomFichier, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) GetFileTime hFile, FTc, FTa, FTw Select Case byType Case 1 ' modification Date de creation Ft = GetFT(sDate) RetVal = SetFileTime(hFile, Ft, FTa, FTw) Case 2 ' modification Date de Lecture Ft = GetFT(sDate) RetVal = SetFileTime(hFile, FTc, Ft, FTw) Case 3 ' modification Date derniere ecriture Ft = GetFT(sDate) RetVal = SetFileTime(hFile, FTc, FTa, Ft) Case 4 ' modification toutes Ft = GetFT(sDate) RetVal = SetFileTime(hFile, Ft, Ft, Ft) End Select End Sub