CODEWITHSUNDEEP
excelvba
Ein_Bear
Ein_Bear

Reputation: 67

Get original creation time for all excel files in a folder

I need to loop through a folder containing many excel files and extract the file name and creation time to a text file. By creation time, I mean the time the file was originally created rather than the time it was created on my system.

The following code works, but gives me the wrong time. I think FileDateTime is the wrong command, but after an hour of desperate googling I haven't been able to find the correct one.

Thanks in advance for the help!

Sub CheckFileTimes()
    Dim StrFile As String
    Dim thisBook As String
    Dim creationDate As Date
    Dim outputText As String
    Const ForReading = 1, ForWriting = 2
    Dim fso, f

'set up output file
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("C:\TEST.txt", ForWriting, True)

'open folder and loop through
    StrFile = Dir("c:\HW\*.xls*")
    Do While Len(StrFile) > 0
'get creation date
       creationDate = FileDateTime("C:\HW\" & StrFile)
'get filename
       thisBook = StrFile
       outputText = thisBook & "," & creationDate
'write to output file
       f.writeLine outputText
'move to next file in folder
       StrFile = Dir
    Loop
    f.Close
End Sub

Upvotes: 4

Views: 6003

Answers (2)

Ein_Bear
Ein_Bear

Reputation: 67

Welp, I found the answer. Looks like I wasn't too far off (though I don't think this is anywhere near optimal). Thanks to everyone who took a look at this.

Sub CheckFileTimes3()
    Dim StrFile, thisBook, outputText As String
    Dim creationDate As Date
    Dim fso, f
    Dim oFS As Object
    Const ForReading = 1, ForWriting = 2

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'open txt file for storing results
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("C:\TEST.txt", ForWriting, True)

    'loop through all files in given folder
    StrFile = Dir("c:\HW\*.xls*")
    Do While Len(StrFile) > 0
       Workbooks.Open Filename:="C:\HW\" & StrFile
       creationDate = ActiveWorkbook.BuiltinDocumentProperties("Creation Date")
       thisBook = StrFile
       outputText = thisBook & "," & creationDate
       'MsgBox outputText
       f.writeLine outputText
       ActiveWorkbook.Close
       StrFile = Dir
    Loop
    f.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Upvotes: 2

brettdj
brettdj

Reputation: 55682

You can use DateCreated with the FileSystemObject.

A small tweak to your current code does this

I have tided up the the variables as well

Sub CheckFileTimes()
Dim StrFile As String
Dim StrCDate As Date
Dim fso As Object
Dim f As Object

'set up output file
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpentextFile("C:\TEST.txt", 2, True)

'open folder and loop through
    StrFile = Dir("c:\HW\*.xls*")
    Do While Len(StrFile) > 0
    Set objFile = fso.getfile("c:\HW\" & StrFile)
'get creation date
       StrCDate = objFile.datecreated
'write to output file
       f.writeLine StrFile & "," & StrCDate
'move to next file in folder
       StrFile = Dir
    Loop
    f.Close
End Sub

Upvotes: 2

Related Questions