[[20091007133324]]　『サブフォルダを含めたファイル一覧』（どすこい）　ページの最後に飛ぶ

『サブフォルダを含めたファイル一覧』（どすこい）

 指定フォルダのファイル一覧を取り出す物なのですが、
 あるところから引用してやっとこ作ったのですが
 サブフォルダに対しては取得出来ません。
 どう修正すれば良いのか教えて下さい。

  Sub fn_get()
     Dim f_name() As String
     Dim i As Integer
     Call Display_Directory("c:\tmp", f_name())
     Do
         If f_name(i) = "" Then Exit Do
         MsgBox f_name(i)
         i = i + 1
     Loop
 End Sub

 ' 指定したフォルダ内のファイルの一覧を取得
 Sub Display_Directory(strPATHNAME As String, fname() As String)
     Const cnsTITLE = "フォルダ内のファイル名一覧取得"
     Const cnsDIR = "\*.*"
     Dim i As Integer
     Dim xlAPP As Application
     Dim strFILENAME As String
     Dim GYO As Long
     Set xlAPP = Application
     ' InputBoxでフォルダ指定を受ける
     If StrConv(strPATHNAME, vbUpperCase) = "FALSE" Then Exit Sub
     ' フォルダの存在確認
     If Dir(strPATHNAME, vbDirectory) = "" Then
         MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE
         Exit Sub
     End If
     ' 先頭のファイル名の取得
     strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal)
     ' ファイルが見つからなくなるまで繰り返す
     Do While strFILENAME <> ""
         ' 次のファイル名を取得
         strFILENAME = Dir()
         GYO = GYO + 1
     Loop
     ReDim fname(GYO)
     ' 先頭のファイル名の取得
     strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal)
         GYO = 0
     Do While strFILENAME <> ""
         fname(GYO) = strFILENAME
         ' 次のファイル名を取得
         strFILENAME = Dir()
         GYO = GYO + 1
     Loop
 End Sub

 まったく違う仕組みにしてしまいましたが、以下でどうでしょうか。
 ファイル名はファイル名を含むフルパスで示されます。
 ファイル名だけにしたい場合には、コメントアウトしている部分を変更してください。
 (ROUGE)
　
Private n As Long
Sub test()
Dim tbl()
Dim i As Long
Const Ps String = "c:\tmp"
n = 0
Call FFS(Ps, tbl())
For i = 1 To UBound(tbl)
    MsgBox tbl(i)
Next
End Sub
Private Sub FFS(ByVal Ps As String, ByRef tbl())
Dim f
With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Ps).Files
        n = n + 1
        ReDim Preserve tbl(1 To n)
        tbl(n) = f.Path  '--> f.Name
    Next
    For Each f In .GetFolder(Ps).SubFolders
        Call FFS(f.Path, tbl())
    Next
End With
End Sub

コメント返信：

[ 一覧(最新更新順) ]

[[20091007133324]] 『サブフォルダを含めたファイル一覧』（どすこい） ページの最後に飛ぶ

[[20091007133324]]　『サブフォルダを含めたファイル一覧』（どすこい）　ページの最後に飛ぶ