[Excel VBA] 複数のサブフォルダにある特定の拡張子のファイルを全て開くには？

題名の通りですが、詳しく書くと↓
＜やりたいこと＞
自ブック(マクロを実行する本体)と同じ場所に複数のサブフォルダがあり、サブフォルダの中にはいくつかの .xlsx ファイルが存在する。
この複数のサブフォルダに存在する .xlsxファイルを全て開きたい。

＜今、躓いている所＞
サブフォルダ内のファイル名取得(拡張子を指定)のコードをどのように記述するのか


同じフォルダ内の .xlsxファイルを全て開くコードは次のようにしてみました。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub SameFolderBook_Open()
Dim FileName As String
Dim wb As Workbook
Dim IsBookOpen As Boolean
Dim myPath As String

myPath = ThisWorkbook.Path & "\"　　　'今開いているブックのパスを取得
FileName = Dir(myPath & "*.xlsx", vbDirectory)　　'myPathの*.xlsxのファイル名を取得
　　Do While FileName <> ""
　　　　For Each wb In Workbooks
　　　　　　If wb.Name = FileName Then　　'既にブックが開いているときの処理
　　　　　　　　IsBookOpen = True
　　　　Exit For
　　　　　　End If
　　　　Next wb
　　　　　　If IsBookOpen = False Then 'ブックを開く処理
　　　　　　　　Application.StatusBar = "データを読込中..."
　　　　　　　　Application.ScreenUpdating = False
　　　　　　　　Workbooks.Open myPath & FileName, ReadOnly:=True
　　　　　　　　ActiveWindow.Visible = False
　　　　　　End If
　　　　IsBookOpen = False
　　　　FileName = Dir()
　　Loop
　Application.StatusBar = False
　Application.ScreenUpdating = True
　ThisWorkbook.Activate
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
サブフォルダ取得なので、Dir()かFSOを使ったコードになるとは思うのですが、コードが思い浮かばず・・・
可能ならば、上記のコードも活かしたい。

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2015/08/05 17:53

こんにちは。

>サブフォルダ内のファイル名取得(拡張子を指定)のコードをどのように記述するのか

雑な書き方で、質問者さんのコードを汚してしまいましたが、こんな感じでループすればどうでしょうか。
たぶん、時間をかければ、私の書いた程度なら書けたはずだと思います。

ファイル名取得なら、
Dir(myPath & "*.xlsx", vbNormal)　　か、ただの　Dir(myPath & "*.xlsx")で良いはずです。

ひとつだけ気になるのは、
　ActiveWindow.Visible = False
　の部分ですが、後、どうやって収拾するのでしょうか？

'//

Sub SameFolderBook_OpenN()
'No. 9037311
　Dim FileName As String
　Dim wb As Workbook
　Dim IsBookOpen As Boolean
　Dim myPath As String
　Dim FolderLists As Variant
　Dim FSO As Object
　Dim objFolder As Object
　Dim i As Long
　Dim obj As Object
　Dim pt As Variant
　Dim buf As String
　myPath = ThisWorkbook.Path & "\"　　　'今開いているブックのパスを取得
　ReDim FolderLists(0)
　FolderLists(0) = myPath
　i = i + 1
　Set FSO = CreateObject("Scripting.FileSystemObject")
　Set objFolder = FSO.GetFolder(myPath)
　For Each obj In objFolder.SubFolders
　　ReDim Preserve FolderLists(i)
　　If Right$(myPath & obj.Name, 1) <> "\" Then
　　　 FolderLists(i) = myPath & obj.Name & "\"
　　Else
　　　 FolderLists(i) = myPath & obj.Name
　　End If
　　i = i + 1
　Next
　
　For Each pt In FolderLists
　FileName = Dir(pt & "*.xlsx",vbNormal)　 'myPathの*.xlsxのファイル名を取得
　　Do While FileName <> ""
　　　For Each wb In Workbooks
　　　　If wb.Name = FileName Then '既にブックが開いているときの処理
　　　　　IsBookOpen = True
　　　　　Exit For
　　　　End If
　　　Next wb
　　　If IsBookOpen = False Then 'ブックを開く処理
　　　　Application.StatusBar = "データを読込中..."
　　　　Application.ScreenUpdating = False
　　　　Workbooks.Open pt & FileName, ReadOnly:=True
　　　　ActiveWindow.Visible = False
　　　End If
　　　IsBookOpen = False
　　　FileName = Dir()
　　Loop
　Next pt
　Application.StatusBar = False
　Application.ScreenUpdating = True
　ThisWorkbook.Activate
End Sub
'///

この回答へのお礼

教えて頂いたコードでうまく動作しました。
開くファイルの数が多い(72個)のか、メモリ不足表示が出ました。メモリ自体は8GBなんですが・・・（苦笑

>ひとつだけ気になるのは、
> 　ActiveWindow.Visible = False
>　の部分ですが、後、どうやって収拾するのでしょうか？
すいません、説明なく入れていました。
自ブックにINDIRECT関数でデータ値を外部参照させている部分があり、データ値のブックは操作する人に見えなくてもよいという理由からです。

課題は解決したので、No.1をベストアンサーに選ばせていただきます。
ありがとうございました。また別の機会によろしくお願い致します。

お礼日時：2015/08/05 19:55