Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Microsoft 365)
複数フォルダをあけて複数ファイルに一括処理を繰り返すマクロ
投稿日時: 22/06/04 14:14:19
投稿者: miyuukate

お世話なってます。
複数フォルダの中の複数ファイルに一括で同じ処理をするマクロを作成しましたが、エラーになるか同じ1つのファイルをずっと繰り返すことになり、うまく動きません。
多分3つのマクロがうまく繋がってないのだと思いますが色々調べてもうまく行かず、アドバイスお願いいたします。
 
※ファイル1〜4に同じ処理をするマクロ
 DドライブのフォルダA→フォルダB→フォルダC→ファイル1,ファイル2
                  フォルダD→ファイル3,ファイル4
 
 マクロのファイルはフォルダBと同じ階層に作成してます。
 処理したいファイル1〜4のシート名は「報告」です。
 
Sub main4()
    Dim inputFolder As String
    Dim fso As Object
     
    Application.EnableEvents = False
     
    inputFolder = "D:\A\B"
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    Call roopAllFiles(inputFolder, fso)
    Set fso = Nothing
     
    Application.EnableEvents = True
     
End Sub
 
Private Function roopAllFiles(ByVal inputFolder As String, ByVal fso As Object)
 
    Const FILE_TYPE_XLSX As String = "xlsx"
     
    Dim folder As Object
    Dim file As Object
     
    For Each folder In fso.GetFolder(inputFolder).SubFolders
        Call roopAllFiles(folder.path, fso)
      Next
       
    For Each file In fso.GetFolder(inputFolder).Files
        If LCase(fso.GetExtensionName(file.Name)) = FILE_TYPE_XLSX Then
                Call execForExcelFile(file)
            End If
      Next
         
End Function
 
Private Function execForExcelFile(ByVal file As Object)
 
    Dim inputFolder As String
     
    inputFolder = "D:\A\B\"
    file = Dir(inputFolder & "*.xlsx")
                 
        Do While file <> ""
             Workbooks.Open Filename:=inputFolder & file
                                     
             Worksheets("報告").Range("A2").Value = "作成"
             Worksheets("報告").Range("A3").Value = "確認"
             
                ActiveWorkbook.Close SaveChanges:=True
              
                 file = Dir()
                
        Loop
   MsgBox "完了"
         
End Function
 
どうぞアドバイスよろしくお願いいたします。
 
 
 

回答
投稿日時: 22/06/04 14:43:34
投稿者: simple

こんにちは。
 
詳細見て確認していないので見落としがあるかもしれませんが、
execForExcelFile というのは、
単に、そのファイルだけを処理すればよいのではないですか?
FSOを使うなら、 Dirを使った繰り返し処理は不要のはずです。
 
その点、見直してみてはいかがですか?
ちなみに、roopではなくloopではないですか?

回答
投稿日時: 22/06/04 15:32:27
投稿者: hatena
投稿者のウェブサイトに移動

すでにアドバイスがあるように FSO を使うなら、Dir のループは不要ですね。
あとは、下記のようなロジックで。
 
C:\Test\B内のフォルダーを探索して、
さらのそのフォルダー内のファイルを探索して、
見つかったエクセルファイルに処理をする
 
 

Sub main4()
    Dim inputFolder As String
    Dim fso As Object
     
    Application.EnableEvents = False
     
    inputFolder = "C:\Test\B"
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    Call roopAllFiles(inputFolder, fso)
    
    Set fso = Nothing
     
    Application.EnableEvents = True
     
End Sub
 
Private Function roopAllFiles(ByVal inputFolder As String, ByVal fso As Object) 
    Const FILE_TYPE_XLSX As String = "xlsx"
    Dim folder As Object
    Dim file As Object
    
    'フォルダー探索 
    For Each folder In fso.GetFolder(inputFolder).SubFolders
        'ファイル探索
        For Each file In fso.GetFolder(folder.Path).Files
            'エクセルファイルなら処理実行
            If LCase(fso.GetExtensionName(file.Name)) = FILE_TYPE_XLSX Then
                Call execForExcelFile(file)
            End If
        Next
    Next
End Function
 
Private Function execForExcelFile(ByVal file As Object) 
    With Workbooks.Open(Filename:=file.Path)
        .Worksheets("報告").Range("A2").Value = "作成"
        .Worksheets("報告").Range("A3").Value = "確認"
        .Close SaveChanges:=True
    End With             
End Function

 
C:\Test\B以下のフォルダー階層は1段としてます。
もし、それ以上の階層がありそれに対しても処理を実行するなら、再帰を使うことになります。

投稿日時: 22/06/04 17:09:03
投稿者: miyuukate

 アドバイスありがとうございます。
 お二人のアドバイスを参考にDirを取って試行錯誤してみました。
 最初なかなかうまくいきませんでしたがコードを参考にさせてもらい、無事すべてのファイルに一括処理をすることができました!
 Callで呼び出す部分が違っていたのとExcelファイルへの処理のところではもうDo〜LoopもDirも使わず、処理のためのコードのみでよかったのですね。
色々と考えすぎてしまい、あれこれと入力したため無限ループに落ちたり、作動しなかったりと行き詰まっていました。
大変勉強になりました。特にFSOの使い方をもっと勉強しようと思います。
どうもありがとうございました。