ドライブの中のファイル一覧（＆サイズ等）を作成するVBAを教えてください！！

質問

ドライブの中フォルダーに関する情報を一覧表にして、どのフォルダーがドライブ容量を圧迫しているか調べたく、下記のVBAを書いてみたのですが、うまく走りません。　取得したい内容は、例えば、My Documentの中に入っている、Folder　Name, Size, DateLastModifiedです。サブフォルダーがある場合は、さらにそのフォルダーの上記の情報も取得したいです。
***************************************************************
Sub FolderList()

Dim fs As Object, fd As Object, f As Object
Dim i As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.GetFolder("C:\Documents and Settings\Ontario91")

If f.Type Like "Folder*" Then
i = i + 1
Cells(i, 1).Value = f.Name
Cells(i, 2).Value = f.DatelastModified
Cells(i, 3).Value = f.Size

End If
Range("A1").CurrentRegion.EntireColumn.AutoFit
End Sub
***************************************************************
VBA初心者なので、精通されている方たちには、かなり初歩的なコードだと思い、恥ずかしいのですが、質問させていただきます。お力添えよろしくお願い致します。

回答No.1

argument · ベストアンサー

はじめまして　Ontario91　さん
あぁ眠い、こんばんわというよりもうおはようございますなのでしょうか？
まぁそんなことはどうでも良いですね。
タイトルは無視しますよ？あくまで質問内容を重視します。
さておき、この手の質問は巨万とある訳ですが検索しましたか？
きっとこのQ&Aサイト内にも間違いなくあるとおもわれますがまぁ良いでしょう。

以下を回答とします。
標準モジュールにコピーしてください。

Public c As Integer
Sub test()
c = 1: Allfolder CreateObject("Scripting.FileSystemObject").GetFolder(CreateObject("WScript.Shell").SpecialFolders("MyDocuments"))
End Sub
Sub Allfolder(objFolder)
For Each objSubFolder In objFolder.SubFolders
Cells(c, 1).Value = objSubFolder.Name
Cells(c, 2).Value = objSubFolder.DatelastModified
Cells(c, 3).Value = objSubFolder.Size
c = c + 1: Allfolder objSubFolder
Next
End Sub

さぁ実行してみましたか？貴方のMyDocumentsがすべて列挙され名前、日付、サイズが表示されました。
質問条件は全て満たしました。はい、解決ですね。

追加処理・処理違い・補足等あればいってください。

お礼

ありがとうございました。
検索して、いくつか試してみましたが、思ったような結果が得られなかったため投稿してしまいました。今後は、検索結果をもっと試してから投稿します。