Getting the original file creation date

[Aussiebear]

In 2011 Kenneth Hobs kindly posted this code as a means to find the original file creation date.


Option Explicit

'http://www.ozgrid.com/forum/showthread.php?t=44778&highlight=change+file+properties
Type FileAttributes
Name As String
Size As String
FileType As String
DateModified As Date
DateCreated As Date
DateAccessed As Date
Attributes As String
Status As String
Owner As String
Author As String
Title As String
Subject As String
Category As String
Comments As String
Keywords As String
End Type

Sub Test_GetFileAttributes()
Dim fa As FileAttributes
fa = GetFileAttributes(ThisWorkbook.FullName)
MsgBox fa.DateCreated
End Sub

'Add Tools > References > Microsoft Shell Controls and Automation
Public Function GetFileAttributes(strFilePath As String) As FileAttributes
' Shell32 objects
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim objFolderItem As Shell32.FolderItem
' Other objects
Dim strPath As String
Dim strFileName As String
Dim i As Integer
' If the file does not exist then quit out
If Dir(strFilePath) = "" Then Exit Function
' Parse the file name out from the folder path
strFileName = strFilePath
i = 1
Do Until i = 0
i = InStr(1, strFileName, "\", vbBinaryCompare)
strFileName = Mid(strFileName, i + 1)
Loop
strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)
' Set up the shell32 Shell object
Set objShell = New Shell
' Set the shell32 folder object
Set objFolder = objShell.Namespace(strPath)
' If we can find the folder then ...
If (Not objFolder Is Nothing) Then
' Set the shell32 file object
Set objFolderItem = objFolder.ParseName(strFileName)
' If we can find the file then get the file attributes
If (Not objFolderItem Is Nothing) Then
GetFileAttributes.Name = objFolder.GetDetailsOf(objFolderItem, 0)
GetFileAttributes.Size = objFolder.GetDetailsOf(objFolderItem, 1)
GetFileAttributes.FileType = objFolder.GetDetailsOf(objFolderItem, 2)
GetFileAttributes.DateModified = CDate(objFolder.GetDetailsOf(objFolderItem, 3))
GetFileAttributes.DateCreated = CDate(objFolder.GetDetailsOf(objFolderItem, 4))
GetFileAttributes.DateAccessed = CDate(objFolder.GetDetailsOf(objFolderItem, 5))
GetFileAttributes.Attributes = objFolder.GetDetailsOf(objFolderItem, 6)
GetFileAttributes.Status = objFolder.GetDetailsOf(objFolderItem, 7)
GetFileAttributes.Owner = objFolder.GetDetailsOf(objFolderItem, 8)
GetFileAttributes.Author = objFolder.GetDetailsOf(objFolderItem, 9)
GetFileAttributes.Title = objFolder.GetDetailsOf(objFolderItem, 10)
GetFileAttributes.Subject = objFolder.GetDetailsOf(objFolderItem, 11)
GetFileAttributes.Category = objFolder.GetDetailsOf(objFolderItem, 12)
GetFileAttributes.Comments = objFolder.GetDetailsOf(objFolderItem, 14)
GetFileAttributes.Keywords = objFolder.GetDetailsOf(objFolderItem, 40)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function


As we all know VBA and Excel has vastly improved over time. Is this still relevant or should I go with this version



Sub GetFileCreationDate()
Dim fso As Object
Dim file As Object
Dim filePath As String
' Replace "YourFilePath.xlsx" with the actual path to your file
filePath = "YourFilePath.xlsx"
' Create a FileSystemObject instance
Set fso = CreateObject("Scripting.FileSystemObject")
' Get a reference to the file
Set file = fso.GetFile(filePath)
' Retrieve the creation date and display it in a message box
MsgBox "File Creation Date: " & file.DateCreated
' Clean up Set file = Nothing
Set fso = Nothing
End Sub


We all get different files over time, and I'm curious to see if a file being presented is modified file or not.

[Paul_Hossler]

I do something similar to the second in my 'toolbox' for various parameters

I find the code easier to follow by making little single purpose functions, but that's just personal style



Option Explicit

Sub drv()
ChDir "c:\Users\Daddy\Desktop\"
MsgBox CreationDate("TestReport_3.xlsm")
End Sub

Function CreationDate(F As String) As Date
With CreateObject("Scripting.FileSystemObject")
'.GetAbsolutePathName uses current folder
CreationDate = .Getfile(.GetAbsolutePathName(F)).DateCreated
End With
End Function

[Dave]

Hi Aussiebear. I'm not sure that the datecreated tells you much. The return tells you when the current file was saved to your pc ie. If you replace a file, the datecreated is the file replacement date not the date that the original file was created. The only thing I use is datelastmodified to find the most current version of a file (datemodified no longer produces a result). I use the FSO method (along with the datelastmodified), as all i really need to know is if the file is current. HTH. Dave

[Aussiebear]

@ Dave. If you were tasked to provide tutoring to a group of students, and during that time you asked the students to submit a workbook example as part of their homework. I would like to know if the workbook is original rather than copied and or amended from an earlier one. To find the Last Modified date i would use either



Sub GetLastModifiedDateWithFSO()
Dim fso As Object
Dim file As Object
Dim lastModifiedDate As Date
Dim filePath As String
filePath = "C:\Your\File\Path\YourFile.xlsx" ' Replace with your file path
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(filePath)
lastModifiedDate = file.DateLastModified
MsgBox "Last Modified Date: " & lastModifiedDate
Set file = Nothing
Set fso = Nothing
End Sub

or perhaps this one



Sub GetLastModifiedDate()
Dim filePath As String
Dim lastModifiedDate As Date
filePath = "C:\Your\File\Path\YourFile.xlsx" ' Replace with your file path
lastModifiedDate = FileDateTime(filePath)
MsgBox "Last Modified Date: " & lastModifiedDate
End Sub

[Aussiebear]

@Paul. Thank you for your assistance.

[Paul_Hossler]

@ Dave. If you were tasked to provide tutoring to a group of students, and during that time you asked the students to submit a workbook example as part of their homework. I would like to know if the workbook is original rather than copied and or amended from an earlier one. To find the Last Modified date i would use either



If they were really smart (or sneaky) it's easy enough to change the file dates :devil2: and the Document Properties :devil2::devil2:

[Aussiebear]

So, how would one go to protect file dates and properties?

[Dave]

Paul's got a point... VBA – Change File’s Date Created or Date Modified (https://www.devhut.net/vba-change-files-date-created-or-date-modified/)
It seems like a combination of BuiltinDocumentProperties and the FSO are needed to get useful information. Here's a summary of what's available from both... https://answers.microsoft.com/en-us/msoffice/forum/all/vba-to-get-content-created-date-property-from-all/5c0d5e3d-11ee-467f-9ce2-5fc5c3e7017f
I really like the simplicity of the FileDateTime function that you provided for retrieving the file date last modified. The following code seems to tell you something. The company and original author is the actual file creator and the last author is whomever saved the file last. However, I don't like the fact that you have to open the wb to access the BuiltinDocumentProperties. There is a difference between content creation date and file creation date that I'm not sure that I understand? You need to format the BuiltinDocumentProperties output cells (B4&B5) to custom date with mins. Anyways, hope this helps and I have no idea how to protect the dates and properties. Dave


Sub test()
Dim Arr As Variant, Wb As Workbook, ThisWb As Workbook, filePath As String
Dim rw As Integer, cnt As Integer, p As Object, FSO As Object, File As Object
' index(s) of desired BuiltinDocumentProperties
' company, author, last author, content creation date, last saved time(last date modified)
Arr = Array(21, 3, 7, 11, 12)
filePath = "C:\Your\File\Path\YourFile.xlsx" ' Replace with your file path
Set ThisWb = ThisWorkbook
Set Wb = Workbooks.Open(filePath)
rw = 1
For cnt = LBound(Arr) To UBound(Arr)
For Each p In Wb.BuiltinDocumentProperties
If p.Name = Wb.BuiltinDocumentProperties(Arr(cnt)).Name Then
ThisWb.Sheets("Sheet1").Cells(rw, 1).Value = p.Name
ThisWb.Sheets("Sheet1").Cells(rw, 2).Value = Wb.BuiltinDocumentProperties(Arr(cnt))
rw = rw + 1
Exit For
End If
Next p
Next cnt
Wb.Close savechanges:=False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.GetFile(filePath)
ThisWb.Sheets("Sheet1").Cells(rw, 1).Value = "File Creation Date"
ThisWb.Sheets("Sheet1").Cells(rw, 2).Value = File.DateCreated
rw = rw + 1
ThisWb.Sheets("Sheet1").Cells(rw, 1).Value = "DateLastAccessed"
ThisWb.Sheets("Sheet1").Cells(rw, 2).Value = File.DateLastAccessed
Set File = Nothing
Set FSO = Nothing
End Sub

[Aussiebear]

Thank you Dave.

[Dave]

Did some more Googling, and this was the best description I could find....
Statistical (Content) Creation Date: shows what date and time the 'original' file was created - stays the same even if the file in question is a copy of the original.
General Creation Date: shows when the file was first created on 'this' computer - this is different from the statistical creation date if the current file is a copy of the original.
It seems to hold true, however I have a file originally created in 1996 that has been revised over time and transferred across different pcs. On one pc the content creation date is correct (ie. 1996) on other pcs, the content creation date is 2023? If I copy the 2023 file to the pc with the 1996 date, the content date becomes 2023? It doesn't seem to make any sense. I think I've learned enough now to remember that file properties/attributes don't tell you much. Apologies Aussiebear if this hasn't helped. Dave

[Paul_Hossler]

100% not fool proof, but you could use a hidden name to store the original save date/time and a 'hidden' sub to display it

You have to know the name of the sub to run it ('SuperSecretSub' in the attachment)

VBA has to be protected ("password" in the attachment)

Change the names of the Name and the sub to make more obscure



Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim i As Long
i = -1
On Error Resume Next
i = Application.Names("_FirstSave").Index
On Error Resume Next
If i = -1 Then ' first save
Application.Names.Add "_FirstSave", Format(Now, "yyyy-mm-dd-hh-mm-ss")
Application.Names("_FirstSave").Visible = False
End If
End Sub


Option Explicit
Option Private Module

Sub SuperSecretSub()
Dim i As Long
i = -1
On Error Resume Next
i = Application.Names("_FirstSave").Index
On Error Resume Next
If i <> -1 Then ' been saved
Call MsgBox("Original Save Date/Time was " & Application.Names("_FirstSave").RefersTo, vbInformation + vbOKOnly, ThisWorkbook.FullName)
End If
End Sub