フォルダー内の最新更新エクセルファイル

質問

勤怠処理を行っています。
記録の方法は、各課や係別にフォルダーがあって、その中に社員が月毎に勤務時間をエクセルファイルで記録しています。
￥＊＊￥Ａ部￥B課￥Ｃ係￥社員A￥12月.xls
と言うような感じで構成されています。Ａ部より下層はフォルダーが複数存在します。
この状態で、Ａ部のフォルダーをユーザーが指定すると、下層のフォルダーを全て検索し、最下層の最新更新日の.xlsのフルパスとファイル名を取得して、それをシート上に表示したいのです。

フォルダー内全てのファイルの最終更新日を取得する方法は検索すると見つかります。それをいじって日付を比較して最新日を抜き出せばいいのでしょうが、コマンドの意味が判っていないので上手く行きません。

完全に「教えて君」で申し訳有りませんが、宜しくお願い致します。

回答No.2

rivoisu · ベストアンサー

Private dt As Date
Private fname As String
Sub test()
Const Ps As String = "c:￥＊＊￥Ａ部"
dt = 0
Call FFS(Ps)
Cells(1, 1) = fname
End Sub
Private Sub FFS(ByVal Ps As String)
Dim f
With CreateObject("Scripting.FileSystemObject")
For Each f In .Getfolder(Ps).Files
If f.DateLastModified > dt Then
dt = f.DateLastModified
fname = f.Path
End If
Next
For Each f In .Getfolder(Ps).SubFolders
Call FFS(f.Path)
Next
End With
End Sub
最新だけのファイルのフルパスがA1に表示されるようにしました。
「再帰呼び出し」が理解しづらいと思って「そこそこ難しいロジック」と書いたのですが。
最新日を探す（最大値を探す、最小値を探す同じロジックです）
要するに最初にdt=0として
ｄｔより大きい日付がきたらの値をｄｔにセットしてそのときのファイル名をFnameに入れる。
全てのファイルの処理が終わるとｄｔに最新日、ｆnameのその名前が残る。

お礼

実際の所コードの意味が分からないところもありますが、パス名を変数で変えていく事により全員の最新ファイルを検索できそうです。
本当にありがとうございました。

回答No.1

rivoisu

＞フォルダー内全てのファイルの最終更新日を取得する方法は検索すると見つかります
それが簡単にできるならそれを提示してもらえばそこから回答へはすぐだと思います。

私にはVBAでの回答で、かつそこそこ難しいロジックしか思いつきません。
それでよければコードを書いてもいいのですが

補足

幾つか見つけたのですが、簡潔なのはこれです。
掲示板から拾ったものですが、質問内容から実行できるの思うのですが、どちらもエラーで停止します。
ファイル名の取得ではConst Ps String = "c:\tmp"
時間取得の方は階層Box.Value
の箇所です。
時間取得の方はIF Thenを削除すれば動作しますが、ファイル名の方は私には全く分かりません。
これでどうでしょうか？

’ファイル名を取得する方法
Private n As Long
Sub test()
Dim tbl()
Dim i As Long
Const Ps String = "c:\tmp"
n = 0
Call FFS(Ps, tbl())
For i = 1 To UBound(tbl)
MsgBox tbl(i)
Next
End Sub
Private Sub FFS(ByVal Ps As String, ByRef tbl())
Dim f
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(Ps).Files
n = n + 1
ReDim Preserve tbl(1 To n)
tbl(n) = f.Path '--> f.Name
Next
For Each f In .GetFolder(Ps).SubFolders
Call FFS(f.Path, tbl())
Next
End With
End Sub

’時間を取得する方法
Function get_folder_path(mes, Optional ByVal opt As Variant = 1)
Dim fld As Object
Set fld = CreateObject("Shell.Application").BrowseForFolder(0, mes, opt, 0)
On Error Resume Next
If Not fld Is Nothing Then
get_folder_path = fld.items.Item.Path
If Err.Number <> 0 Then
get_folder_path = False
End If
Else
get_folder_path = False
End If
End Function
Sub test()
Dim ファイルパス As Variant
Dim tbl() As Variant, i As Long, f As Object
ファイルパス = get_folder_path("保存先フォルダを選択して下さい")

If TypeName(ファイルパス) <> "Boolean" Then
階層Box.Value = ファイルパス
End If

With CreateObject("Scripting.FileSystemObject").Getfolder(ファイルパス)
ReDim tbl(1 To .Files.Count, 1 To 4) '2と3は他のフィールドで使用の為4に年月日
For Each f In .Files
i = i + 1
tbl(i, 1) = f.Name
tbl(i, 4) = Format(f.DateLastModified, "yyyy-mm-dd") '時間まで入っるので、時間を削除
Next f
End With

End Sub