Excel VBAでフォルダー・ファイル名の取得

いつもお世話になります。

Ｅｘｃｅｌで、決められたディレクトリーの下にあるフォルダー名とファイル名を取得して
Ｅｘｃｅｌに表示したいのですが、調べたのですがよくわかりませんですた。

決められたディレクトリーは固定で、その下には複数フォルダーがあります。

よろしくお願い致します。

No.3 ベストアンサー 回答者： goo793ww 回答日時： 2011/01/04 03:44

自作ツールの一部なのですが如何でしょうか。

Public Function FindPath(ByVal FindTopPath As String) As String
Dim scrptFldr As Scripting.Folder
Dim scrptFile As Scripting.File
Dim R As Long
On Error GoTo Err_FindPath
DoEvents
'ファイル
For Each scrptFile In zzFSO.GetFolder(FindTopPath).Files
R = R + 1
Cells(R, 1) = "F"
If Right$(FindTopPath, 1) <> "\" Then
Cells(R, 3) = FindTopPath
Else
Cells(R, 3) = FindTopPath
End If
Cells(R, 4) = scrptFile.Name
Cells(R, 5) = scrptFile.Size / 1024
Cells(R, 6) = scrptFile.DateCreated
Cells(R, 7) = scrptFile.DateLastModified
Cells(R, 8) = scrptFile.DateLastAccessed
Next
'フォルダ
For Each scrptFldr In zzFSO.GetFolder(FindTopPath).SubFolders
R = R + 1
Cells(R, 1) = "D"
If Right$(FindTopPath, 1) <> "\" Then
Cells(R, 3) = FindTopPath & "\" & scrptFldr.Name
Else
Cells(R, 3) = FindTopPath & scrptFldr.Name
End If
Cells(R, 4) = "○"
Cells(R, 5) = scrptFldr.Size / 1024
Cells(R, 6) = scrptFldr.DateCreated
Cells(R, 7) = scrptFldr.DateLastModified
Cells(R, 8) = scrptFldr.DateLastAccessed
'ネスト
If zzNextFlag = True Then
FindPath = FindPath(scrptFldr.Path)
If FindPath <> "" Then
Exit Function
End If
Else
End If
Next
Exit Function

Err_FindPath:
If zzFldrName1 <> FindTopPath & scrptFldr.Name Then
zzCountX = zzCountX + 1
Cells(R, 3) = FindTopPath & "\" & scrptFldr.Name
Cells(R, 4) = "●"
Cells(R, 6) = scrptFldr.DateCreated
Cells(R, 7) = scrptFldr.DateLastModified
Cells(R, 8) = scrptFldr.DateLastAccessed
End If
zzFldrName1 = FindTopPath & "\" & scrptFldr.Name
Resume Next
End Function

<追記>
宜しければ、参考URL配下の「UiK4010 ファイル検索.xls」をダウンロードし試行してみて下さい。
⇒便利ツール⇒UiK4010 ファイル検索.xls
以上

参考URL：http://cid-30eb9f2aea0e6b00.office.live.com/docu …

この回答へのお礼

ありがとうございます。

参考にさせていただきました。

ご丁寧な回答、感謝いたします。

お礼日時：2011/02/18 12:23

No.2 回答者： nda23 回答日時： 2010/12/27 17:28

こういう感じでしょうか。

Sub メイン()
Dim シート As WorkSheet
Dim 行 As Long
Dim シェル As Object
Dim フォルダ As Object
Dim オブジェクト As Object

Set シート = ThisWorkbook.WorkSheets(1)
行 = 0
Set シェル = CreateObject("Shell.Application")
Set フォルダ = シェル.Namespace("C:\hoge～")
For Each オブジェクト In フォルダ.Items
　　　　行 = 行 + 1
　　　　シート.Cells(行, 1) = オブジェクト.Name
　　　　シート.Cells(行, 2) = IIf(オブジェクト.IsFolder, "フォルダ", "ファイル")
Next
End Sub

もし、サブフォルダ内を更に追求するなら、
フォルダ内オブジェクトを列挙する部分を
別プロシージャとして再帰的に呼び出せば
よいでしょう。

この回答へのお礼

ありがとうございます。

教えて頂いたソースでうまくいきました。

本当にありがとうございます。

お礼日時：2011/02/18 12:22

No.1 回答者： n-jun 回答日時： 2010/12/27 16:47

ファイルを検索する

http://officetanaka.net/excel/vba/tips/tips36.htm

考え方として参考になると思います。

この回答へのお礼

ありがとうございます。

サイト参考にさせて頂きました。

お礼日時：2011/02/18 12:22