VBA How to amend the date created of another file

Question

I'm trying to amend the Created Date of a list of files using excel and vba.

I've worked out how to amend the modified date using the below data, but I'm unable to get it to work on the DateCreated.

Sub update_file_dates()

Dim oFSO    As Object
Dim oShell  As Object
Dim oFile   As Object
Dim oFolder As Object
Dim sFile   As String
Dim rw, erw As Integer

rw = 2
erw = sh01.Cells(sh01.Rows.Count, 1).End(xlUp).Row

Do Until rw > erw

    sFile = sh01.Cells(rw, 2) & "\" & sh01.Cells(rw, 1)
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oShell = CreateObject("Shell.Application")
    Set oFile = oFSO.GetFile(sFile)
    Set oFolder = oShell.Namespace(oFile.ParentFolder.Path)
    
    oFolder.Items.Item(oFile.Name).ModifyDate = DateSerial(2000, 1, 12) + TimeSerial(5, 35, 17)
    
    Set oFolder = Nothing
    Set oFile = Nothing
    Set oShell = Nothing
    Set oFSO = Nothing

    rw = rw + 1

Loop

End Sub

Thank you

Answer 1

You will need to use the Windows API for this task. I took the liberty of updating the code you provided, using code I pulled from my library:

Sub update_file_dates()
   Dim sFile  As String
   Dim rw, erw As Integer

   rw = 2
   erw = sh01.Cells(sh01.Rows.Count, 1).End(xlUp).Row

   Do Until rw > erw
      sFile = sh01.Cells(rw, 2) & "\" & sh01.Cells(rw, 1)
      SetFileCreationDate sFile, CDate("Jan 12, 2000 5:35:17 AM"), True
      rw = rw + 1
   Loop
End Sub

Here is the referenced code:

Public Function SetFileCreationDate(ByVal File As String, ByVal NewDate As Date, ByVal UseLocalTime As Boolean) As Boolean
   Dim TempTime As FILETIME
   Dim CreationTime As FILETIME
   Dim OrigianlAttributes As Long
   Dim Handle As Long

   SetFileCreationDate = True
   CreationTime = DateToFileTime(NewDate)

   If UseLocalTime Then
      LocalFileTimeToFileTime CreationTime, TempTime
      CreationTime = TempTime
   End If

   OrigianlAttributes = GetAttr(File)
   SetAttr File, vbNormal
   Handle = CreateFile(File, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
   
   If Handle = 0 Then Exit Function

   If SetFileCreatedTime(Handle, CreationTime, ByVal 0&, ByVal 0&) = 0 Then
      CloseHandle Handle
      Exit Function
   End If

   If CloseHandle(Handle) = 0 Then Exit Function
   
   SetAttr File, OrigianlAttributes
End Function

and the Windows API code:

Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal NoSecurity As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileCreatedTime Lib "kernel32" Alias "SetFileTime" (ByVal hFile As Long, lpCreationTime As FILETIME, ByVal NullLastAccessTime As Long, ByVal NullLastWriteTime As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long

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 Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3

Private Function DateToSystemTime(ByVal MyDate As Date) As SYSTEMTIME
   DateToSystemTime.wYear = Year(MyDate)
   DateToSystemTime.wMonth = Month(MyDate)
   DateToSystemTime.wDay = Day(MyDate)
   DateToSystemTime.wHour = Hour(MyDate)
   DateToSystemTime.wMinute = Minute(MyDate)
   DateToSystemTime.wSecond = Second(MyDate)
End Function

Private Function DateToFileTime(ByVal MyDate As Date) As FILETIME
   Dim ft As FILETIME
   Dim st As SYSTEMTIME

   st = DateToSystemTime(MyDate)
   Call SystemTimeToFileTime(st, ft)
   DateToFileTime = ft
End Function