ファイル名一覧マクロ

　このマクロでは、入力プロンプトで指定したフォルダの中にあるファイルの情報を、サブフォルダの中も含めて、ExcelのSheet1に書き出すマクロです。成果物一覧のドラフトを作る時などに便利です。
　構成は、まず、mainプロシージャでフォルダ名を入力し、Sheet1をクリアして以前のデータを消去してから、タイトル行を書き出します。その後、WriteFileListプロシージャを呼び出し、フォルダ内のファイル名等を書き出します。もし当該フォルダにサブフォルダがある場合には、そのサブフォルダ内のファイルに対しても同様の処理を行います。
　以下の2つのプロシージャをExcelの標準モジュールにコピー＆ペーストすれば、そのまま使用できます。

' フォルダ名の入力、タイトル行の書き出しを行うメインプロシージャ
Sub main()

   ' 対象フォルダの入力
   sFolder = InputBox("フォルダ名を入力", "フォルダの指定", "C:")

   ' 画面更新OFF
   Application.ScreenUpdating = False

   ' シートのクリア
   ThisWorkbook.Sheets("Sheet1").UsedRange.Delete

   ' タイトル行の書き出し
   ThisWorkbook.Sheets(1).Cells(1, 1) = "ファイル名"
   ThisWorkbook.Sheets(1).Cells(1, 2) = "フォルダ名"
   ThisWorkbook.Sheets(1).Cells(1, 3) = "ファイル種別"
   ThisWorkbook.Sheets(1).Cells(1, 4) = "最終更新日"
   ThisWorkbook.Sheets(1).Cells(1, 5) = "ファイルサイズ"

   ' タイトル行の属性
   ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 5)).Interior.Color = RGB(153, 255, 255)
   ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 5)).Font.Color = RGB(0, 0, 0)
   ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 5)).HorizontalAlignment = xlCenter

   ' 書き出し位置設定
   i = 2

   ' サブプロシージャの呼び出し
   WriteFileList sFolder, i

   ' 画面更新ON
   Application.ScreenUpdating = True

End Sub

' ファイル名を書き出すサブプロシージャ
Sub WriteFileList(sFolder, i)

   ' オブジェクト型変数の代入
   Set objFileSystem = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFileSystem.GetFolder(sFolder)
   Set objSubFolders = objFolder.SubFolders
   Set objFiles = objFolder.Files

   ' フォルダ内のファイル処理
   For Each File In objFiles
      ' ファイル名の書き出し
      ThisWorkbook.Sheets(1).Cells(i, 1) = File.Name

      ' フォルダ名の書き出し
      ThisWorkbook.Sheets(1).Cells(i, 2) = File.ParentFolder.Path

      ' ファイル種別の書き出し
      ThisWorkbook.Sheets(1).Cells(i, 3) = File.Type

      ' 最終更新日の書き出し
      ThisWorkbook.Sheets(1).Cells(i, 4) = File.DateLastModified

      ' ファイルサイズの書き出し
      ThisWorkbook.Sheets(1).Cells(i, 5) = Int(File.Size)

      i = i + 1
   Next

   ' サブフォルダが存在する場合には同様の処理を繰り返す
   For Each SubFolder In objSubFolders
      WriteFileList SubFolder.Path, i
   Next

End Sub

ホーム