エクセルVBA：サブフォルダ内のマクロ付きエクセルを開く

サブフォルダ内のマクロ付きエクセルを開くマクロを作成中です。
しかし、一つ目を処理した時点で、マクロが終了してします。
サブフォルダ内のマクロはオープンとともにマクロが動く仕様です。

ーーーー
Sub サブフォルダを開く()

Dim myFolder As Variant
Dim FSO As Object
Dim GetFolder As Object
Dim Fol As Object
Dim FileName As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook

Set FSO = CreateObject("Scripting.FileSystemObject")

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show <> 0 Then

    myFolder = .SelectedItems(1)

End If

End With

Set GetFolder = FSO.GetFolder(myFolder)

For Each Fol In GetFolder.SubFolders

With CreateObject("WScript.Shell")

.CurrentDirectory = Fol

End With

FileName = Dir("*.xlsm")

Do While FileName <> ""

If FileName <> ThisWorkbook.Name Then

    IsBookOpen = False
    
    For Each OpenBook In Workbooks
                
        If OpenBook.Name = FileName Then
        
            IsBookOpen = True
            
            Exit For
            
        End If
        
    Next
    
    If IsBookOpen = False Then
                      
        Workbooks.Open (FileName), UpdateLinks:=1
                                 
    End If
    
End If

Application.Wait Now() + TimeValue("00:00:10")

FileName = Dir()

Loop

Set GetFolder = Nothing

End Sub
ーーーー

行動規範の内容に同意します

回答1件

ベストアンサー

サブフォルダ内のVBAの中でEndを使っているのではないですか？
Endを使うと呼び出し元のVBAも含めて終了するようです。

Endの使用をやめて、Exit Sub などを使って処理を終了させる必要があるかと思います。

もしかしたら他にもVBAの実行を止める処理もあるかもしれませんが。
（追記）
起動時のマクロで起動したファイル自身をクローズしている場合もありました。
「起動時のマクロで起動したファイル自身をクローズ」するのをやめて
呼び出し側でクローズする必要があります。

今回の事例であれば
「起動時のマクロで起動したファイル自身をクローズ」している箇所をカットorコメントアウトし
呼び出し時のコードを以下のようにすることになると思います。

VBA
1Dim subbook As Workbook
2Set subbook = Workbooks.Open(FileName, UpdateLinks:=1)
3subbook.Close SaveChanges:=True

呼び出される側を修正したくない場合、以下になります

VBA
1           If IsBookOpen = False Then
2           
3                Dim xlApp As Excel.Application
4                If xlApp Is Nothing Then
5                    Set xlApp = New Excel.Application
6                    xlApp.Visible = True
7                End If
8                xlApp.Workbooks.Open FSO.BuildPath(Fol, FileName), UpdateLinks:=1
9               
10            End If
11       
12        End If
13       
14        Application.Wait Now() + TimeValue("00:00:10")
15       
16        FileName = Dir()
17   
18    Loop
19
20Next
21
22Set GetFolder = Nothing
23
24If Not xlApp Is Nothing Then
25    xlApp.Quit
26End If
27
28

投稿2021/04/17 18:16

編集2021/04/19 01:39

xail2222

総合スコア1508

abcdefg12345

2021/04/17 23:34

Exit Sub　にして使おうと思うと、どうしてもEnd subを使用してくださいと出ます。

xail2222

2021/04/17 23:43

end subは必要です。 end単独があれば変えた方が良いと言うことです。あとendが原因じゃなければ、原因を探るにはWorkbooks.Open (FileName)に、ブレークポイントを設定して、ステップインして、開いたbookの処理を引き続きステップ実行して何処でとまるかを調べた方が良いかと思います

xail2222

2021/04/18 04:10

質問に提示のコードを私の所で試したところ、問題のないマクロは順に開いて処理できました。ので、問題は、サブフォルダ内のマクロという事だと思います。問題なければ「サブフォルダ内のマクロはオープンとともにマクロが動く」というそのマクロのコードを提示してもらえれば、何かわかるかもしれません。　かもですが。

abcdefg12345

2021/04/18 14:18

Sub　XXXXXX() Application.ScreenUpdating = False Workbooks.Open "エクセルのパス.xlsx" If ActiveSheet.ListObjects.Count > 0 Then Range("A1").ListObject.TableStyle = "" Range("A1").ListObject.Unlist End If Dim Filter_Month Dim Criteria_Month Workbooks.Open "パス¥抽出用月.xlsx" Dim s '// セル値 Dim r As Range '// 対象セルのRangeオブジェクト '// 空セルまでループ For Each r In Range("B1:B100") '// セル値を取得 s = r.Value '// セル値が未設定の場合 If s = "" Then Exit For End If Filter_Month = s Workbooks("ファイルの名前.xlsx").Activate With Range("A3").CurrentRegion .AutoFilter Field:=13, Criteria1:=Filter_Month .AutoFilter Field:=1, Criteria1:="XXXX" .AutoFilter Field:=6, Criteria1:="XXXX" End With Dim i As Long i = WorksheetFunction.Subtotal(9, Columns(8)) Debug.Print ActiveWorkbook.Name If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If Workbooks("このブック.xlsm").Activate Worksheets(Worksheets.Count).Copy After:=Worksheets(Worksheets.Count) Application.DisplayAlerts = False ActiveSheet.Range("S1").Value = i Dim t As Long t = Filter_Month On Error Resume Next ActiveSheet.Name = Left(ActiveSheet.Name, 16) & t If Err.Number = 1004 Then Application.DisplayAlerts = False '警告メッセージを表示しない Sheets(Left(ActiveSheet.Name, 16) & t).Delete Application.DisplayAlerts = True ActiveSheet.Name = (Left(ActiveSheet.Name, 16) & t) End If If Range("S1") = "0" Then Dim l, k l = ActiveSheet.Name k = ActiveWorkbook.Name Workbooks.Open "パス\要確認.xlsx" Dim MAXrow MAXrow = Cells(Rows.Count, 1).End(xlUp).Row Cells(MAXrow + 1, 2).Value = l Cells(MAXrow + 1, 1).Value = k Cells(MAXrow + 1, 3).Value = Date & " " & Time ActiveWorkbook.Save End If Call SheetToFile Next ActiveWorkbook.Close SaveChanges:=True End Sub て感じなんですが・・

abcdefg12345

2021/04/18 14:20

これが100個くらいあります。それを自動で開いて勝手に数値収集してテキストファイルを作成するようにしたいです。これらのエクセル100はそれぞれ単体なら動きます

xail2222

2021/04/18 17:01 編集

最後の「ActiveWorkbook.Close SaveChanges:=True」が誰をクローズしているのか正確には分からないのですが、開かれたファイル自身をクローズしているのであれば、回答に追記したようにそれをやめる必要があります。あと一点、今回の問題とは関係がないのですが可能であれば最後の「ActiveWorkbook.Close SaveChanges:=True」のように ActiveWorkbookって、どのファイルのことなのか。というのがわからなくなるのを避けるためにファイル自身であればActiveWorkbookではなく、ThisWorkbookにするとか色々な原因から、改めるべき箇所が色々あります。出来上がってるコードに手を入れまくるのも避けた方がいいかもしれないので、今回必ず修正すべきだとはいいませんが、今後のコーディングに際しては改めた方がよいかと思います。色々あるのでリンクを探してきました。まだ、リンク先のことだけでは足りない部分もあると感じますが改善はされるかと思います。 https://errormaker.blog.fc2.com/blog-entry-33.html https://qiita.com/mima_ita/items/8b0eec3b5a81f168822d#excel-vba%E5%9B%BA%E6%9C%89%E3%81%AE%E3%82%AC%E3%82%A4%E3%83%89%E3%83%A9%E3%82%A4%E3%83%B3

abcdefg12345

2021/04/18 22:47

ActiveWorkbook.Close SaveChanges:=True　はThisworkbook.close SaveChanges:=Trueでも大丈夫です。ご親切にありがとうございます。これで試してみます。

xail2222

2021/04/18 23:22 編集

いや。Thisworkbook.close SaveChanges:=Trueは、コードの記述方法として書いただけで、それでは開かれたファイル自身をクローズしている事に変わりないので改善しないです。自分をクローズすると処理がそこで止まってしまい呼び出し元へも戻らなくなってしまいますもしどうしても自分をクローズしないと行けない場合、呼び出し方を変える必要があります。別のexcelを起動してファイルを開く方法なのですが色々問題があるかもしれません。呼び出されるexcelファイルは呼び出し元のファイルを起動しない状態で手動で起動していってももきちんと動作するのですか？

abcdefg12345

2021/04/19 01:44

呼び出されるexcelファイルは呼び出し元のファイルを起動しない状態で手動で起動していってももきちんと動作するのですか？この場合は起動するんです。

xail2222

2021/04/19 03:01 編集

了解しました。回答に追記した内容で行けるのではと思いますん？起動？クローズしないと言うことですか？ならまだ手を入れないと行けないかもですね

abcdefg12345

2021/04/19 12:22

すみません、いただいた回答で無事解決しました！ありがとうございました。このスレッドの使い方がいまいちよくわからず、ご返信遅くなり申し訳ありません。大変助かりました。先ほど、ベストアンサーにさせていただきました。

xail2222

2021/04/19 12:50

解決してほっとしました。最後に記載したパターンで解決したのでしょうか。大量にマクロファイルがある場合、修正は大変ですよねあと一点気になっている所があるのですが「Application.Wait Now() + TimeValue("00:00:10")」は、何の為にあるのですか？なぜ、10秒待つのか疑問でした。

abcdefg12345

2021/04/19 14:14

最後に記載したパターンで解決したのでしょうか。その通り、上記で解決しました。　開いたマクロがまたいくつものマクロを参照して処理をする、×３を繰り返すので（？）、オートメーションエラーが起きたためです。なくても大丈夫そうですかね？？

abcdefg12345

2021/04/19 14:15

いろいろご教示いただきましてありがとうございました。大変助かりました。

xail2222

2021/04/19 14:23

なるほど。解決したパターンについてわかりました。「オートメーションエラーが起きたためです。なくても大丈夫そうですかね？？」に関しては、エラーに出くわしてみないと分からないですね。無くても大丈夫そうな気はしますが、運用上有用な対処であるならば、無暗になくすのも怖いので、処理時間的に問題がないならそのままの方が良いかと思います。ただ時間がかかるので、無くすか時間を短くして、上手く行くかチャレンジするのも悪くはないと思いました。ということでwaitの理由に関してもわかりました。説明ありがとうございました。

行動規範の内容に同意します