ディレクトリ内のすべてのブックのシートを検索する - Excel、VBA

Question

現在、ディレクトリ内の複数のワークブックからすべてのワークシート名のリストをコンパイルしようとしています。これまでのところ、私は目的の結果を得るためのコードをいくつか見つけて編集しましたが（下記参照）、一度に1つのワークブックについてのみです。私が取り除く必要がある400のワークブックが簡単にあり、私はこれより難しくなるよりは少しスマートに作業しようとしています。残念なことに、これらのワークブックは、ディレクトリ内の任意のフォルダまたはサブフォルダに保存できますが、唯一の整合性は唯一の.xlsmファイルです。これを行い、各ワークブックのワークシートのタイトルを別々の列に表示する方法がありますか？ ご協力いただければ幸いです！

Answer 1

次のサブを試してください。それがあなたを助けることを願っています。

Sub EachSHinEachBook() 
    Dim FolderNme As String 
     FileType = "*.xls*"  'The file type to search for 
     OutputRow = 2 'The first row of the active sheet to start writing to     

     filepath = "C:\MyExcelFiles\" 'The folder to search 

     ThisWorkbook.ActiveSheet.Range("A" & OutputRow).Activate 
     OutputRow = OutputRow + 1 
     Curr_File = Dir(filepath & FileType) 
     Do Until Curr_File = "" 
      Set FldrWkbk = Workbooks.Open(filepath & Curr_File, False, True) 
      ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = Curr_File 
      ThisWorkbook.ActiveSheet.Range("B" & OutputRow).ClearContents 'Clear any previous values 
      OutputRow = OutputRow + 1 

      For Each Sht In FldrWkbk.Sheets 
       ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Sht.Name 
       ThisWorkbook.ActiveSheet.Range("A" & OutputRow).ClearContents 'Clear any previous values 
       OutputRow = OutputRow + 1 
      Next Sht 
      FldrWkbk.Close SaveChanges:=False 
      Curr_File = Dir 
     Loop 
     Set FldrWkbk = Nothing 
    End Sub