質問: true thisworkbook.activate end sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー サブフォルダ取得なので、dir()かfsoを使ったコードになるとは思うのですが、コードが思い浮かばず・・・ 可能ならば、上記のコードも活かしたい。
回答: こんにちは。 >サブフォルダ内のファイル名取得(拡張子を指定)のコードをどのように記述するのか 雑な書き方で、質問者さんのコードを汚してしまいましたが、こんな感じでループすればどうでしょうか。 たぶん、時間をかければ、私の書いた程度なら書けたはずだと思います。 ファイル名取得なら、 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 '///