重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら>

電子書籍の厳選無料作品が豊富!

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

A 回答 (4件)

再帰呼び出しの話がでてたので、ついでに再帰を使った方法も。


こちらは 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
    • good
    • 0
この回答へのお礼

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

お礼日時:2006/11/13 18:42

こんにちは。

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
    • good
    • 0

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

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

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

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() は自作する必要があります。
※ 条件の詳細が判らないので、今日はこの程度で・・・。

この回答への補足

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

補足日時:2006/11/09 11:06
    • good
    • 0

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


手法を用います。

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

とても勉強になる手法だと思いますので、がんばってください。
    • good
    • 0
この回答へのお礼

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

お礼日時:2006/11/09 11:06

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!