LoginSignup
1
2

More than 5 years have passed since last update.

ファイル一覧を取得し、新しいシートに出力する

Last updated at Posted at 2018-01-26

ファイルの一覧取得処理(fileutilクラス)は以下の記事のものを使わせてもらった。
VBAマクロでファイル一覧を再帰的に取得するFunctionプロシージャを作成してみた。

ファイル一覧を新シートに出力
Sub FileList2NewSheet()
    'ファイル一覧取得
    Dim targetpath As String: targetpath = InputBox("ファイル一覧を取得したいフォルダパスを入力してください。", "入力", "")
    Dim fu As fileutil: Set fu = New fileutil
    Dim result As Collection: Set result = fu.getFileListRecursive(targetpath).Files

    '新シート作成
    Sheets.Add

    'ヘッダ作成
    Range("A1:D1").Interior.Color = RGB(220, 120, 120)
    Range("A1:D1").Value = Array("フォルダ", "ファイル名", "日付", "サイズ")
    Range("A2").Select
    ActiveWindow.FreezePanes = True

    '結果出力
    Dim r: r = 2
    Dim objFiles As File
    For Each objFiles In result
        Dim p1: p1 = objFiles.ParentFolder 'フォルダ
        Dim p2: p2 = objFiles.Name 'ファイル名
        Dim p3: p3 = FileDateTime(objFiles) '日付
        Dim p4: p4 = Format(objFiles.Size / 1024, "#.0") 'サイズ
        Range(Cells(r, 1), Cells(r, 4)) = Array(p1, p2, p3, p4)
        r = r + 1
    Next

    '列幅調整
    Columns("A:D").EntireColumn.AutoFit
End Sub
fileutil
Option Explicit

Private m_fso As FileSystemObject
Private m_files As Collection

Property Get FSO() As FileSystemObject
    Set FSO = m_fso
End Property

Property Get Files() As Collection
    Set Files = m_files
End Property

' ファイル一覧を再帰的に取得する関数
' 引数: folder_path 取得する起点のフォルダ
' 引数: pattern 取得対象のパターン(正規表現)
Public Function getFileListRecursive(folder_path As String, Optional pattern As String = "") As fileutil
    ' ファイル一覧の結果格納用
    Dim file_list_tmp As Collection

    ' ループ用変数の宣言
    Dim folder As Variant
    Dim file_path As Variant
    Dim dir As Variant

    ' オブジェクトの初期化
    Set file_list_tmp = New Collection

    ' 現在ディレクトリ内の全ファイルの取得
    For Each file_path In FSO.GetFolder(folder_path).Files
        If file_path Like "*" & pattern & "*" Then
            DoEvents    ' フリーズ防止用
            Call Files.Add(file_path)
        End If
    Next

    ' サブディレクトリの再帰
    For Each dir In FSO.GetFolder(folder_path).SubFolders
        Call getFileListRecursive(dir.Path, pattern)
    Next


    Set getFileListRecursive = Me
End Function

' メンバ変数の初期化
Private Sub Class_Initialize()
    Set m_fso = New FileSystemObject
    Set m_files = New Collection
End Sub

' メンバ変数の解放
Private Sub Class_Terminate()
    Set m_fso = Nothing
    Set m_files = Nothing
End Sub
1
2
2

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2