获取文件夹中所有Excel文件的原始创建时间

时间:2012-11-14 05:59:44

标签: excel excel-vba vba

我需要遍历包含许多excel文件的文件夹,并将文件名和创建时间提取到文本文件中。创建时间是指文件最初创建的时间,而不是在系统上创建的时间。

以下代码有效,但给了我错误的时间。我认为FileDateTime是错误的命令,但经过一个小时的绝望谷歌搜索后,我找不到正确的命令。

提前感谢您的帮助!

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

2 个答案:

答案 0 :(得分:1)

您可以将DateCreatedFileSystemObject一起使用。

对当前代码进行一些小调整

我也提到了变量

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

答案 1 :(得分:1)

Welp,我找到了答案。看起来我并不太远(虽然我认为这不是最接近的)。感谢所有看过这个的人。

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