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

質問

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

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

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

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

回答No.3

goo793ww · ベストアンサー

自作ツールの一部なのですが如何でしょうか。
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/documents.aspx

お礼

ありがとうございます。

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

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

回答No.2

nda23

こういう感じでしょうか。
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

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

お礼

ありがとうございます。

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

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

回答No.1

n-jun

ファイルを検索する
http://officetanaka.net/excel/vba/tips/tips36.htm

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

お礼

ありがとうございます。

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