VBA – Changer la date et l’heure d’un fichier

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