3

多くの Excel ファイルを含むフォルダーをループし、ファイル名と作成時間をテキスト ファイルに抽出する必要があります。作成時間とは、システムでファイルが作成された時間ではなく、ファイルが最初に作成された時間を意味します。

次のコードは機能しますが、間違った時間が表示されます。間違ったコマンドだと思いますFileDateTimeが、1時間必死にグーグル検索した後、正しいコマンドを見つけることができませんでした.

助けてくれてありがとう！

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
4

2 に答える 2

1

DateCreatedで使用できますFileSystemObject。

現在のコードを少し調整するだけでこれが実現します

変数も調整しました

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
于 2012-11-14T06:21:55.977 に答える
1

ウェルプ、私は答えを見つけました。私はそれほど遠くないように見えます（これが最適に近いとは思いませんが）。これを見てくれたみんなに感謝します。

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
于 2012-11-14T06:48:05.083 に答える