ExcelVBA ファイル一覧を出力

質問

こんにちは
指定したフォルダ配下にある全てのファイル一覧を、シート上にA1から下に向かってズラズラ出力したいのですが、どのように書けばいいですか？
フォルダの下に位置するファイルも全て、ということで困っています
よろしくお願いします

回答No.4

KenKen_SP · ベストアンサー

再帰呼び出しの話がでてたので、ついでに再帰を使った方法も。
こちらは File System Object を使ってます。

File System Object の非常に良く考えられた構造のおかげでコードは
すっきりします。ただし、VB 標準の Dir 関数などと比べても速度は
かなり遅いですけど、ご質問の用途だと実用上でも十分だと思います。

#3 と同じようなコードではつまらないので、セルへの書き出し方法も
配列を使った一括転記にひねってます。

　# 参考までに
　# ファイル操作は API を使うのが一番早いです。速度重視なら、
　# FindFirstFile、FindNextFile API あたりを調べてみて下さい。

' FileSystemObject 版
Sub ファイルの列挙その2()

　　Dim sRootPath As String
　　Dim Folder　　As Object
　　Dim Buffer()　As String

　　' 列挙するルートフォルダ
　　sRootPath = "C:\Sample"
　　' File System Object の Folder オブジェクト生成
　　Set Folder = CreateObject("Scripting.FileSystemObject") _
　　　　　　　　.GetFolder(sRootPath)
　　'ファイル列挙（第二引数の String 型配列にファイルパスが返ります
　　Call EnumFiles(Folder, Buffer, True)
　　With ActiveSheet
　　　　.Cells.Clear
　　　　.Range("A1").Value = sRootPath
　　　　.Range("A3").Resize(UBound(Buffer) + 1).Value = _
　　　　　　Application.Transpose(Buffer)
　　End With
　　Set Folder = Nothing

End Sub

' フォルダ・ファイルの列挙サブプロシージャ
Private Sub EnumFiles( _
　　ByVal ParentFolder As Object, _
　　ByRef Buffer() As String, _
　　Optional ByVal CheckSubFolder As Boolean)

　　' 引数：ParentFolder FileSystemObject の Folder オブジェクト
　　'　　 ：Buffer() String 型配列 Byref でここにパスが格納されていく
　　'　　 ：[CheckSubFolder] True：サブフォルダもチェックする

　　Dim File　 As Object
　　Dim Folder As Object
　　Dim i　　　As Long

　　For Each File In ParentFolder.Files
　　　　On Error Resume Next
　　　　i = UBound(Buffer) + 1
　　　　On Error GoTo 0
　　　　ReDim Preserve Buffer(i)
　　　　Buffer(i) = File.Path
　　Next
　　If CheckSubFolder Then
　　　　For Each Folder In ParentFolder.SubFolders
　　　　　　' サブフォルダ内の再帰呼び出し
　　　　　　EnumFiles Folder, Buffer, True
　　　　Next
　　End If

End Sub

お礼

回答ありがとうございます！
参考になります！

回答No.3

KenKen_SP

こんにちは。KenKen_SP です。

FileSearch オブジェクトを使うと割と楽ですよ。ただし、FileSearch は
不安定なのがたまにキズ。

' FileSearch オブジェクト版
Sub ファイルの列挙()

　　Dim FS　　　　　As FileSearch
　　Dim Sh　　　　　As Worksheet
　　Dim i　　　　　 As Long
　　Dim vFile　　　 As Variant

　　' 長所：簡単。サブフォルダを調べる場合でも再帰呼び出し不要
　　' 短所：不安定で信頼性に欠ける

　　Set Sh = ActiveSheet
　　Set FS = Application.FileSearch
　　With FS
　　　　' 調べるフォルダのパス（ルートフォルダのパス）
　　　　.LookIn = "C:\Sample"
　　　　' サブフォルダを含めるか
　　　　.SearchSubFolders = True
　　　　' この例では全てのファイル（例えば *.xls なら Excel ファイルのみ）
　　　　' その他にも .FileType = msoFileTypeWordDocuments のようにフィルタ
　　　　' することも可能
　　　　.Filename = "*.*"
　　End With
　　' ファイルパス書き込み開始行
　　i = 3
　　' Excecute(ソートの種類を指定可能)
　　If FS.Execute(msoSortByNone) > 0 Then
　　　　Sh.Cells.Clear
　　　　Sh.Cells(1, "A").Value = FS.LookIn
　　　　For Each vFile In FS.FoundFiles
　　　　　　Sh.Cells(i, "A").Value = vFile
　　　　　　i = i + 1
　　　　Next
　　Else
　　　　MsgBox "ファイルは無いみたい(´・ω・`) ", vbExclamation
　　End If
　　Set FS = Nothing
　　Set Sh = Nothing

End Sub

回答No.2

noname#22222

D:\x\y\ya.txt
D:\x\y\yb.txt
D:\x\y\yc.txt
D:\x\z\za.txt
D:\x\z\zb.txt
D:\x\z\zc.txt

というフォルダの構造で

ya.txt
yb.txt
yc.txt
za.txt
zb.txt
zc.txt

と表示するのは割と簡単です。
が、ネスト構造が更に複雑であれば再帰を利用するのでややこしいです。

一応、テスト済みですが、上述のような限られた条件ですと次のようです。
コードそのものの本体は、僅か１０行程度の簡単なものです。

Private Sub CommandButton1_Click()
　　Dim I　　　　　　As Integer
　　Dim J　　　　　　As Integer
　　Dim K　　　　　　As Integer
　　Dim N　　　　　　As Integer
　　Dim M　　　　　　As Integer
　　Dim strFolders() As String
　　Dim strFiles()　 As String

　　strFolders() = GetFolderList("D:\x")
　　N = UBound(strFolders())
　　For I = 0 To N
　　　　strFiles() = GetFileList("D:\x\" & strFolders(I))
　　　　M = UBound(strFiles())
　　　　For J = 0 To M
　　　　　　K = K + 1
　　　　　　Me.Cells(K, 1) = strFiles(J)
　　　　Next J
　　Next I
End Sub

※　Microsoft scripting runtime を利用しています。
※　GetFolderList()、GetFileList() は自作する必要があります。
※　条件の詳細が判らないので、今日はこの程度で・・・。

補足

回答ありがとうございます！
条件は特に無いのですが・・・強いて言うならば、通常ファイルだけです！よろしくお願いします

回答No.1

siddhaartha

そのような場合は、自身で自身をコールバックする「再起呼出し」という
手法を用います。

[関数Ａ]----------------------------
指定されたフォルダの直下のファイルを書き出し、
サブフォルダがあれば、そのサブフォルダを指定して
自分（関数Ａ）を呼び出す。
------------------------------------
そうすることによって、階層がどれだけ深くても
サブフォルダが無くなるまで処理することができます。

とても勉強になる手法だと思いますので、がんばってください。

お礼

回答ありがとうございます！
再起呼出し・・・難しそうですが、がんばってみます！