サブフォルダ内の全てのテキストファイルを１発処理する方法

質問

Excel2007のVBAを使い、下記のようなマクロを作成しました。
（質問に必要そうな所だけ掲載しています。）

Dim dir_name As String ' ディレクトリ名
Dim file_name As String ' ファイル名
Dim EffectiveRow As Integer ' 開始行数/Excel/Row(行)
Dim ShellApp As Object ' SHDOCVW.DLL / MIC
Dim oFolder As Object ' フォルダパス

EffectiveRow = Range("A65536").End(xlUp).Row

Set ShellApp = CreateObject("Shell.Application")
Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)

dir_name = oFolder.items.Item.Path

ChDir dir_name

file_name = Dir("*.txt", vbNormal)

Do Until file_name = ""
EffectiveRow = EffectiveRow + 1
Call ImportText(file_name, EffectiveRow)
file_name = Dir()
Loop

ShellApp.BrowseForFolderを使い、指定したフォルダを選択すると、
その中に有る、テキストファイル(.txt)を、全てExcelに書き込む
というマクロを作成したのですが、もっと汎用性を高くするために、
下記の内容を実現したく思っています。

- ↓ 実現したい事↓ -
- 状況 -
*フォルダの中に、サブフォルダが複数有り、そのサブフォルダの中に、
テキストファイル(.txt)が複数入っている。

- 処理 -
サブフォルダを格納している*フォルダを、ShellApp.BrowseForFolderで
選択し、一度でサブフォルダ内のテキストファイルを全てExcelに書き込
めるようにしたい。

上記のマクロから発展させて、このような処理を行う事は出来るでしょうか？
また、どのようにすれば実現させることが出来るでしょうか？

ご教授のほど、よろしくお願いします。m(_ _)m

※ [*フォルダ ] は同一フォルダです。

回答No.4

myRange

途中から。。。

'----------------------------------------------
●ChDir dir_name　　'●これ不要だと思うが。。
dir_name = oFolder.items.Item.Path

Dim fso
Dim fsoFolder
Dim fsoSubFolder

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(dir_name)

For Each fsoSubFolder In fsoFolder.SubFolders

　file_name = Dir(fsoSubFolder & "\*.txt", vbNormal)

　Do Until file_name = ""
　　　EffectiveRow = EffectiveRow + 1
　　　Call ImportText(file_name, EffectiveRow)
　　　file_name = Dir()
　Loop

Next fsoSubFolder
'------------------------------------------

それから、Dir関数を使用せずに

For Each fsoSubFolder In fsoFolder.SubFolders
　　For Each fsoFile In fsoSubFolder.Files
　　　　If Right(fsoFile, 4) = ".txt" Then

とする方法もありますが後がこの場合のfsoFileはフルパスになります。

■注■
サブフォルダーの中に更にサブフォルダーがある場合は上記ではできません。
その場合は再起処理をすることにになります。
以上です。

お礼

やりたかった処理を実装出来ました。
ありがとうございました！m(_ _)m

回答No.3

mitarashi

http://okwave.jp/qa4847039.html
のNo.2に下位フォルダーも含むファイルリストを取得するコードを回答しています。全フォルダーを調べ終わってから、得られたファイルリストに対して書き出し処理するというのではいかがでしょうか。ファイルリストに加えるときにテキストファイルだけ選別するか、あるいは得られたファイルリストの中でテキストファイルだけを処理対象にする様な処置は必要ですが。

お礼

やりたかった処理を実装出来ました。
ありがとうございました！m(_ _)m

回答No.2

nda23

Dim FSO, FLD
Set FS= CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(oFolder.items.Item.Path)
処理 FLD

Sub 処理(FLD) '★再帰呼び出しによる処理
　　Dim SF
　　For Each SF In FLD.SubFolders '★フォルダ内のサブフォルダ
　　　　処理 SF '★各サブフォルダに対し同じことを繰り返す
　　Next
　　'★-- ここからフォルダ内のファイルの処理
　　ChDir FLD.Path
　　Dim file_name
　　file_name = Dir("*.txt")
　　=== ここからは以前の処理なので省略 ===
End Sub

お礼

ご返答ありがとうございます。

ここまでヒントを頂いても難しい…。
もう少し悩んでみます。
ありがとうございますm(_ _)m

回答No.1

fujillin

こんにちは

ひとつのフォルダ内の処理はできているのですよね？
その中で、サブフォルダが見つかったら、そのサブフォルダを引数にして
自分自身を呼び出せるように、全体を少し修正すればできると思います。
（キーワード：再帰処理）

＜参考＞
http://itpro.nikkeibp.co.jp/article/COLUMN/20060206/228661/
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html

補足

ご回答有りがとうございます。
何となくは解るのですが、中々上手く
いきません・・・。

１つめのサブフォルダを見終わったら、
次のサブフォルダに移動する？方法が
解らないというのが１つあります（汗