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
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