Excel VBA ファイル一覧とファイル作成日（更新日）を出力

質問

Excel　VBA ファイル一覧とファイル作成日（更新日）を出力
はじめまして
指定したフォルダのファイル名一覧の出力方法は、ｍｓｎ相談箱を参考にさせていただき、
再帰法を使ったやりかたで出力することができましたが、
同時にファイルの作成日を出力する方法を教えていただけないでしょうか。
よろしくお願いします。

回答No.1

nicotinism · ベストアンサー

こんな感じでいかがでしょう？
投稿用にタブを全角スペースにしています。
Sheet1 の A1 セルに調べたいフォルダ名を入力して
標準モジュールに貼り付けて、マクロ makeFileList を実行してみてください。
Sheet2にリストがでるかと。
ところで、ここはカテゴリ違いですよ。

Sub makeFileList()
　　Call fileList
　　MsgBox "終了しました"
End Sub

Function fileList(Optional trgDir As String = "", Optional fCnt As Long = 0)
　　On Error GoTo err
　　Dim objFs As Object
　　Dim objDir As Object
　　Dim objFile As Object
　　Dim i As Long

　　Set objFs = CreateObject("Scripting.FileSystemObject")

　　If trgDir = "" Then
　　　　Set objDir = objFs.Getfolder(Sheets("sheet1").Range("a1"))
　　Else
　　　　Set objDir = objFs.Getfolder(trgDir)
　　End If

　　Set objFile = objDir.Files

　　With Sheets("sheet2")
　　　　For Each objFile In objDir.Files
　　　　　　　　fCnt = fCnt + 1
　　　　　　　　.Cells(fCnt, 1).Offset(1, 0) = fCnt
　　　　　　　　.Cells(fCnt, 2).Offset(1, 0) = objFile.Path
　　　　　　　　.Cells(fCnt, 3).Offset(1, 0) = objFile.DateCreated
　　　　　　　　.Cells(fCnt, 4).Offset(1, 0) = objFile.DateLastModified
　　　　Next objFile

　　　　For Each objDir In objDir.SubFolders
　　　　　　If objDir.Attributes <> 22 Then　　 'システムフォルダ除外

　　　　　　　　　　'--------------サブフォルダの再帰検索
　　　　　　　　　　　　Call fileList(objDir.Path, fCnt)
　　　　　　　　　　'--------------サブフォルダの再帰検索

　　　　　　End If
　　　　Next objDir
　　End With

　　Set objFile = Nothing
　　Set objDir = Nothing
　　Set objFs = Nothing
Exit Function

err:
　　Select Case err.Number
　　　　Case 76 ' path がない
　　　　　　MsgBox "path 指定が間違っています"
　　　　Case Else
　　　　　　MsgBox err.Number & vbCrLf & err.Description
　　End Select

　　Set objFile = Nothing
　　Set objDir = Nothing
　　Set objFs = Nothing
End Function

お礼

本当にありがとうございます。
思い描いていた通りになりました。
さらにこんなに早く対応して頂きありがとうございます。

カテゴリの件、すいません。
次回から気を付けます。
本当にありがとうございました！！！！！