複数のフォルダの中にあるファイルからシートを検索する

Excel VBA For Each…Next

2024.10.142024.06.15

ExcelVBAで複数のフォルダーの中にあるファイルからシートを検索する方法を紹介します。

VBEを起動して「挿入」→「標準モジュール」を選択して標準モジュールを作成します、作成した標準モジュールのModule1に下のコードを貼り付けます。

Sub 複数のフォルダの中にあるファイルからシートを検索する()

Dim folder_name(12) As String                   '12個の配列要素の宣言をします
Dim file_name As String
Dim sheet_name As String
sheet_name = Range("A1").Value                  'A1のセル値を変数sheet_nameに格納します。
    
folder_name(0) = ThisWorkbook.Path & "\フォルダ1\"
folder_name(1) = ThisWorkbook.Path & "\フォルダ2\"
folder_name(2) = ThisWorkbook.Path & "\フォルダ3\"
folder_name(3) = ThisWorkbook.Path & "\フォルダ4\"
folder_name(4) = ThisWorkbook.Path & "\フォルダ5\"
folder_name(5) = ThisWorkbook.Path & "\フォルダ6\"
folder_name(6) = ThisWorkbook.Path & "\フォルダ7\"
folder_name(7) = ThisWorkbook.Path & "\フォルダ8\"
folder_name(8) = ThisWorkbook.Path & "\フォルダ9\"
folder_name(9) = ThisWorkbook.Path & "\フォルダ10\"
folder_name(10) = ThisWorkbook.Path & "\フォルダ11\"
folder_name(11) = ThisWorkbook.Path & "\フォルダ12\"
    
Dim i As Integer
Dim Q As Integer
    
i = 0                                           '変数iを0にしてフォルダ名(folder_name)を初期値にします。
    
For Q = 1 To 12                                 'For..Nextステートメントで12回繰り返します。
    
   file_name = Dir(folder_name(i) & "*.xlsx")   'フォルダ内のファイル名を1つずつ変数(file_name)に格納します。
    
   Do While file_name <> ""                     'フォルダ内にエクセルのファイルが見つかる間は処理を行います。
                
      Workbooks.Open folder_name(i) & file_name 'ファイルを開きます。
         
      Dim Sheet As Worksheet
      Dim Flag As Boolean
         
      For Each Sheet In Worksheets

         If Sheet.name = sheet_name Then Flag = True

      Next Sheet

      If Flag = True Then

         MsgBox "検索したシートがありました、シートを選択します。"
         Worksheets(sheet_name).Select
         Exit Sub
            
      End If
         
      Workbooks(file_name).Close SaveChanges:=False 'ファイルを閉じます。
         
      file_name = Dir()                        '次のファイルを探します。
        
   Loop
    
   i = i + 1                                   'iの値を1つずつ増やして(folder_name)を0～11まで変えていきます。
    
Next Q

MsgBox "検索したシートはありません。"

End Sub