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
