VBA

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

Temps de lecture 2 minutes

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

Related posts

VBA – Boite de dialogue « Fichier »

Frédéric LE GUEN

VBA – Enlever les accents

Frédéric LE GUEN

VBA – Lancer un programme à une heure donnée

Frédéric LE GUEN

Laissez un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.

Ce site utilise des cookies pour améliorer votre expérience et vos recherches. Nous pensons que vous êtes dʼaccord sur ce principe mais vous pouvez refuser cette option. Accepter Continuer

Privacy & Cookies Policy