全ファイル名をセルに出力するVBAプログラム

質問

VBA初心者です。
Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。
1には「apple1.csv」、「orange1.csv」、「banana1.csv」
2には「apple2.csv」、「orange2.csv」、「banana1.csv」
・・・
4には「apple4.csv」、「orange4.csv」、「banana4.csv」
が入っています。
この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1～A10セルを新たなファイルに自動転記する（apple1はA1～A10,apple2はＢ10～B10・・・）といった具合のマクロを組みたいと思っています。
そこで以下のＨＰを参考にし、まずはトップディレクトリである「C:\Sample」の中のすべてのフォルダを表示するプログラムをつくってみようと試みました。
ホームページでは以下のソース
Sub Sample()
Call FileSearch("C:\Sample")
End Sub

Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
Next Folder
End Sub
によってイミディエイトにフォルダを表示する仕様になっています。
実際、私もこのソースで実行したところ、イミディエイトにはトップディレクトリ以下の全ディレクトリ名が表示されました。
これを改良し、２列目に全ディレクトリ名が表示されるプログラムを組みました。ソースは以下です。
Sub Sample()
Call FileSearch("C:\Sample")
End Sub

Sub FileSearch(Path As String)
Dim FSO As Object, Folder As Variant
' Dim i As Integer
' i = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To FSO.GetFolder(Path).SubFolders
Debug.Print Folder.Path
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
i = i + 1
Cells(i, 2) = Folder

Next i
End Sub
これを実行したところ、２列目にはすべてのディレクトリは表示されず、一部のディレクトリしか表示されません。
改良の仕方がおそらくまずいと思うのですが、何か私が根本的に間違えている気がするので、ご指摘いただけたら幸いです。

回答No.5

imogasi

質問が長くて、十分読んでいないが、フォルダごとに、出力をエクセルのシートの「列」を別列に変えるならCells(i, 2)　の「２」の部分も、Cells(i, j) にして、（「i」はモジュールを脱出して、再突入するごとに、1になるが、）「ｊ」はそう（なっては困るので）ならないように、モジュール外に変数定義をしなければならないと思うがこの点が、思う通りの結果が出ない原因ではないか。
別列にしたくないなら本回答は無視してください。＞Ｂ10～B10とあるから、多分列を改めるのだよね。
ーー
他人のコードをコピペするスキルの段階では、「再帰」ルーチンの、「再帰」利用は過ぎたやり方かと思う。練習として、使わない方法もやってみたら。

お礼

遅れました。
ありがとうございます。
参考にし、自分なりに少しアレンジしたら所望の動作をしました。
ほんとうに助かりました

回答No.4

ushi2015

こんにちは、No1です。
元のコードは一応動いているのかと思い込んでました。
動いてなかったでしょ？
Sub FileSearch(Path As String)
　　Dim FSO　　As Object
　　Dim Folder As Variant
　　Dim j　　 As Long
　　j = Range("B" & Rows.Count).End(xlUp).Row
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　For Each Folder In FSO.GetFolder(Path).SubFolders
　　　　Debug.Print Folder.Path
　　　　j = j + 1
　　　　Cells(j, 2) = Folder
　　　　Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
　　Next
End Sub
こうして下さい。

お礼

遅れました。
ありがとうございます。
そもそも質問のソースがうごきませんでした
参考にし、自分なりに少しアレンジしたら所望の動作をしました。
ほんとうに助かりました

回答No.3

ushi2015

こんにちは、No1です。
i はダブって使っているのでまずいですね。
No2さんのご指摘のように引数で渡すか、
Sub FileSearch(Path As String)
　　Dim FSO　　As Object
　　Dim Folder As Variant
　　Dim i　　 As Long
　　Dim j　　 As Long
　　j = Range("B" & Rows.Count).End(xlUp).Row
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　For i = 1 To FSO.GetFolder(Path).SubFolders
　　　　Debug.Print Folder.Path
　　　　j = j + i
　　　　Cells(j, 2) = Folder
　　　　Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
　　Next i
End Sub
のようにするとかですね。

お礼

遅れました。
ありがとうございます。
質問文も間違っててすみません
参考にし、自分なりに少しアレンジしたら所望の動作をしました。
ほんとうに助かりました

回答No.2

NotFound404

ここでエラーメッセージが出ませんかね。
>For i = 1 To FSO.GetFolder(Path).SubFolders
セルの行位置 i も渡す必要があります。
お手本にならってこんな風では？

Sub Sample2()
Call FileSearch2("c:\sample", 0)
End Sub

Sub FileSearch2(Path As String, i As Long)
Dim FSO As Object, Folder As Variant

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each Folder In FSO.GetFolder(Path).SubFolders
i = i + 1
Debug.Print i, Folder.Path
Cells(i, 2) = Folder.Path
Call FileSearch2(Folder.Path, i) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
Next

End Sub

お礼

遅れました。
ありがとうございます。
参考にし、自分なりに少しアレンジしたら所望の動作をしました。
ほんとうに助かりました

回答No.1

ushi2015

こんにちは
Debug.Print Folder.Path
Cells(i, 2) = Folder
Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す
i = i + 1
としてみては？
i の初期値は書き出す行位置にして下さいね。

お礼

遅れました。
ありがとうございます。
動作しました。