Excel VBAでサブフォルダ内のファイルを呼び出したい

フォルダの下に複数階層のサブフォルダがあり、その下に複数のエクセルブックがあります。これらのブックのシート複数ですが、名前は統一されています。
これらのファイルを呼び出した上でのある特定の名前のシートを呼出し、それぞれ1枚のシートに上から順に貼り付けたいと考えています。
よろしくご教授お願いします

No.6 ベストアンサー 回答者： argument 回答日時： 2008/09/30 21:46

こんばんわ　matchy4649　さん

ん～すっかり夜ですね。晩御飯の支度をする前にちょちょいと作って回答を投下しておきましょう。
以下は二階層ならば正常に動作します。
c:\workの部分はあなたの任意のフォルダ名とし、以下を新規bookに書き込んでください。




Sub test()
directory = "C:\work"
For Each fl In CreateObject("Scripting.FileSystemObject").GetFolder(directory).subfolders: fn = fn & directory & "\" & fl.Name & "/": Next: If InStr(fn, "\") > 0 Then folderlist = Split(Left(fn, Len(fn) - 1), "/") Else folderlist = Array("")
For i = 0 To UBound(folderlist)
fn = "": For Each fl In CreateObject("Scripting.FileSystemObject").GetFolder(folderlist(i)).Files: fn = fn & fl.Name & "/": Next: If InStr(fn, "/") > 0 Then filelist = Split(Left(fn, Len(fn) - 1), "/") Else filelist = Array("")
For j = 0 To UBound(filelist)
Workbooks.Open Filename:=folderlist(i) & "\" & filelist(j): Sheets("3").Select: Sheets("3").Copy Before:=Workbooks(ThisWorkbook.Name).Sheets(1): Sheets("3").Name = Left(filelist(j), Len(filelist(j)) - 4) & "3"
Next
Next
End Sub


どうですか？実行してみましたか？新規bookには
「各ファイル名＆3」という名前で全てのbookシート3が新規bookに追加されました。
詳細を頂けなかったのでこれは二階層専用です。ちなみに順番は気にしませんでした。どうしてもというならば実装しますが・・・。
少なからず現状の仕様みたし、現在おっしゃるディレクトリ構成ならば正常に動作するはずです。



追加処理・処理違い・補足等あればいってください。

この回答へのお礼

ありがとうございました！出来ました！！

お礼日時：2008/10/02 09:51

No.5 回答者： argument 回答日時： 2008/09/30 17:11

こんばんわ　matchy4649　さん

日も暮れてきましたね。
つまり一つのbookに、とあるフォルダの下位階層の全てのbookのsheet3をアルファベット順にシートに纏める。でよろしいですか？
また、bookの数などどうにでも処理できますが、階層は二階層までなのでしょうか？それならば再帰的にする必要はほぼない。

以下の用に三階層以上
root
│
├あ:フォルダ
│├a:book
│├b:book
│├c:book
│├い
││├h:book
││├i:book
││└j:book
││
・
・
のようにならない？ならないのであれば全然再帰的処理じゃなく二階層分でよいのでもっと楽(処理の書き方が少し変わってきます）。

まぁ条件さえきちんと分かれば基本的に回答つまりソースを書いても構いませんが。
最初に言ったとおり"仮に"作成依頼の場合。本来は規約違反だと知っていますよね？
VBAのカテゴリ以外でも本来は
「自分はソースがここまでかけます。ここまでかけましたがこの処理がうまくいません」と書くのがマナーです。
まぁ良いでしょう。回答者が減る(もしくは削除依頼を誰かに出されいつの間にか消える)程度の問題です。
それに私はどうせ分かる範囲なら回答してしまうでしょうから…。

No.4 回答者： argument 回答日時： 2008/09/30 15:20

おはようございます　matchy4649　さん

久々の休日で寝すぎました(朝方までおきてたので)。
まぁそんなことはどうでもいいですね。
3番さんの説明(処理定義)を見てもさっぱりわかりませんでした。
2の補足より後の回答なのに補足のフォルダ・ファイル名が完全無視でいまいちよくわかりません。この問題にrenge(セル処理)は必要ない気がしますし・・。
とりあえず、今回の問題を私が書くならばこのように纏めますがどうでしょうか？意味はあってますか？

まず、現在下記のように用にファイルが格納されています。
root(とあるフォルダ)
│
├あ:フォルダ
│├a:book
│├b:book
│└c:book
│
├2:フォルダ
│├d:book
│├e:book
│└f:book
・
・
・
これ以降も複数あり、さらにあり階層も深くなる


また、bookのシート名は統一されており以下のような構成である
book
├1:sheet
├2:sheet
└3:sheet


今回するべき処理は以下となる
・各階層に新規bookを作成する(ただしほかにbookがない場合は作成しない)。
・新規bookに必要なデータはその階層にあるアルファベット名のbookのシート3全てである
・シートはアルファベット順で格納される事

処理後は下記のようにデータが格納されている事。
また、深くネストしていてもrootフォルダ配下全てのファイルが対象となる。
root
│
├あ:フォルダ
│├新規book
││├(sheet1)aのbookのsheet3
││├(sheet2)bのbookのsheet3
││└(sheet3)cのbookのsheet3
││
│├a:book
│├b:book
│└c:book
│
├2:フォルダ
│├新規book
││├(sheet1)dのbookのsheet3
││├(sheet2)eのbookのsheet3
││└(sheet3)fのbookのsheet3
││
│├d:book
│├e:book
│└f:book
・
・
・

「こうですか？わかりません」
どうやらこの言葉はネタらしい。とつい最近しりました。いや、まぁどうでもいいんですが。このような感じの処理なのでしょうか？
もちろんこうなれば再帰的処理が必要になりfsoも必要でしょうが。

この回答への補足

argumentさんこんにちは。この表示だと分かりやすいですね。
自分がどれだけ分かりにくい説明をしていたか痛感します。
ありがとうございました。引用させていただきました。恐縮です。
私がやりたいのは以下のような事です。
ただし、「あ」フォルダ、「２」フォルダのファイル数はいつも一定ではありません。

root
│
├あ:フォルダ
││
│├a:book
│├b:book
│└c:book
│
├2:フォルダ
│├d:book
│├e:book
│└f:book
・
・
・
新規book
││├(sheet1)aのbookのsheet3
││├(sheet2)bのbookのsheet3
││└(sheet3)cのbookのsheet3
││└(sheet4)dのbookのsheet3
││└(sheet5)eのbookのsheet3
││└(sheet6)fのbookのsheet3

ご教授願えたら幸いです。

補足日時：2008/09/30 16:01

No.3 回答者： YON56 回答日時： 2008/09/30 11:03

質問を次の様に理解して、回答します。

・マクロによって作成されるファイルのNameを[AA]、Fullname(保存場所を含めたName)を[BB]とします。
・ファイルAAのシート名を左から順に[A][B][C][D]とします。
・参照するファイルのFullnameを[AAA][BBB][CCC][DDD]とします。
・また、貼付するシートの名を[X]とします。
・なお、「各種名前のデータがマクロを実行するファイルのシート[Y]に次のように記述してある。」とします。
　セルA1;AA,セルA2;BB,セルB1;A,セルB2;B,セルB3;C,セルB4;D,
セルC1;AAA,セルC2;BBB,セルC3;CCC,セルC4;DDD,セルD1;X
マクロ文
Dim P
Dim PP,QQ,RR
Dim PPP()
Sheets(Y).Select
PP=Range("A1").Value
QQ=Range("A2").Value
RR=Range("D1").Value
ReDim PPP(4,2)
For P=1 To 4
PPP(P,1)=Cells(P,2).Value
PPP(P,2)=Cells(P,3).Value
Next P
For P=1 To 4
Workbooks.Open FileName:=PPP(P,2)
IF P=1 THEN
Sheets(RR).Copy
ActiveWorkbook.Name=PP
Else
Sheets(RR).Copy After:=Workbooks(PP).Sheet(P-1)
End If
ActiveSheet.Name=PPP(P,1)
Workbooks(PPP(P,2)).Close False
Next P
Workbooks(PP).SaveAs FileName:=QQ

**これは一例です。
データの取得方法、変数の定義の仕方等々を創意工夫して、
ご自分の理解し易い記述をして下さい。

No.2 回答者： argument 回答日時： 2008/09/30 01:44

こんばんわ　matchy4649　さん

名前が統一されているというのは同じ名前なのかはたまた連番か何かで規則性があるという意味なのか・・。同じ名前ならば同名ブックは同時に開けないので呼び出した上ではなく順に呼び出すとなります。
順に開いた上でその中のシートを選択するのかなぁ？
>それぞれ1枚のシートに上から順に貼り付けたい
ここの意味が特にわからない。
文章が全体的に抽象的で何がどれを指しているのかわかり辛すぎる。
ディレクトリ構成はどうでもいいとしてもどんな作業がしたいかさっぱりわからない。作業例もない。例文ない。仮に作業依頼にしても作成すらできません。

ちなみに再帰的処理が必ずしも必要なわけではありません。
再帰的処理"でも"できるだけで、なくても下位フォルダ・下位ファイルの全取得は可能です(もちろんソース的には再帰的処理の方が断然きれいですけどね。)

この回答への補足

argumentさん、こんばんは。
読み返してみると本当に分かりにくい文章でした。申し訳ありません。

ファイル名は「あ」というフォルダの下に「a」、「b」、「c」というファイルがあり、2というフォルダの下に「d」、「e」、「f」というファイルがあります。
「a」、「b」、「c」、「d」、「e」、「f」はそれぞれ「1」、「2」、「3」という3つの同じ形式のシートで構成されております。
そのうちうシート「3」のみをそれぞれ特定のファイルにシート貼付を行いたいと考えております。
（新規ファイルのsheet1にファイル「a」の「3」を、sheet2にファイル「b」の「3」を、sheet3に「c」の「3」を、sheet4に「d」の「3」を、と考えています。文章が稚拙ですみません。

当方Excel2002使用です。

補足日時：2008/09/30 02:36

No.1 回答者： marbin 回答日時： 2008/09/29 17:08

「再帰処理」が必要になります。

http://typea.dip.jp/tips/wiki.cgi?page=Excel+VBA …
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

この回答へのお礼

下のリンクが役立ちました。ありがとうございました！

お礼日時：2008/10/02 09:52