更新日時が新しい順に処理するマクロ

' 更新日時が新しい順に処理するマクロ
' ファイルシステムオブジェクトを使用して、更新日時などの情報を、シートに記載
' 更新日時で並び替え
' 並び替え後のシートの情報を元に、順次処理
' 使用したシートを削除
Private Sub SortDateLastModified()
    Const fpath As String = "C:\TEMP"       ' このフォルダ内のファイルを処理
    
    Application.ScreenUpdating = False
    
    ' このファイルに、新規ワークシート追加
    Dim ws As Worksheet
    ThisWorkbook.Activate
    Set ws = Worksheets.Add
    
    'ファイルシステムオブジェクトを使用
    Dim FL As Object 'ファイル
    With CreateObject("Scripting.FileSystemObject")
        Dim i As Long
        i = 1
        ' １ファイルのデータを、１行に書込み
        For Each FL In .GetFolder(fpath).Files
            ws.Cells(i, 1) = FL.DateLastModified    ' 更新日時
            ws.Cells(i, 2) = FL.Name                ' ファイル名
            ws.Cells(i, 3) = FL.Path                ' パス名
            ws.Cells(i, 4) = FL.Size                ' サイズ
            
            i = i + 1
        Next
    End With
    
    
    If ws.Range("A1") = "" Then
        ' A1セルが空白であれば、マクロ終了
        Exit Sub
    Else
        ' 並び替え
        ws.Sort.SortFields.Clear        ' 既存の条件をクリア
        ws.Sort.SortFields.Add2 _
            Key:=ws.Range("A1"), _
            SortOn:=xlSortOnValues, _
            Order:=xlDescending, _
            DataOption:=xlSortTextAsNumbers
        ' Add2：条件追加
        ' Key：この例では、A列が基準で並び替え。行はどこでもOK。
        ' SortOn：並び替えのタイプ、データ（xlSortOnValues）
        '        ・背景色（xlSortOnCellColor）・文字色（xlSortOnFontColor）・アイコン（xlSortOnIcon）
        ' Order：昇順（xlAscending） ・降順（xlDescending）
        ' DataOption：文字列を文字（xlSortNormal）or数値（xlSortTextAsNumbers）
        With ws.Sort
            .SetRange ws.UsedRange          ' 並び替えの範囲。この例では、使用されているセル範囲
            .Header = xlNo                 ' タイトル行の有（xlYes）無（xlNo）,自動判定（xlGuess）。
            .MatchCase = False              ' 大文字と小文字の区別の有（True）無（False）。
            .Orientation = xlTopToBottom    ' 並び変える方向、行（xlTopToBottom）列（xlLeftToRight）。
            .SortMethod = xlPinYin          ' 日本語を、ふりがな（xlPinYin） or 文字コード（xlStroke）で並び替える。
            .Apply                          ' 並び替えを実行
        End With
    
    End If
    
    Dim wb As Workbook
    Dim rw As Long
    
    For rw = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
        ' 以下にファイル毎の処理を記載して活用する
        '   例えば､ファイルを開く処理
        Set wb = Workbooks.Open(ws.Cells(rw, 3))
    
    
    Next rw
    
    Application.DisplayAlerts = False       '確認メッセージを表示しない｡
    ' シート削除
    ws.Delete
    Application.DisplayAlerts = True        '確認メッセージを表示する｡
    
    Application.ScreenUpdating = True

End Sub

' ファイルの更新日時を確認し、ファイル名と更新日時のペアをユーザー定義型(f)に追加します。
' SortDatesDescending 関数を追加し､ファイルの更新日時を降順にソートし、fのインデックスを取得します｡
' このfのインデックス毎にループ処理し､ファイルを更新日時の新しい順に処理します｡

' ユーザー定義型
Private Type myFile
    Name As String
    Date As Date
End Type

Private f() As myFile

' 更新日時が新しい順に処理するマクロ
Private Sub 更新日時()
    Const fpath As String = "C:\TEMP"
    Dim idx As Variant
    Dim wb As Workbook
    
    Application.ScreenUpdating = False
    
    'ファイルシステムオブジェクトを使用
    Dim FL As Object 'ファイル
    With CreateObject("Scripting.FileSystemObject")
        Dim i As Long
        i = 1
        For Each FL In .GetFolder(fpath).Files
            ReDim Preserve f(1 To i)
            f(i).Name = FL.Name
            f(i).Date = FL.DateLastModified
            i = i + 1
        Next
    End With
    
    ' 更新日時が新しい順にファイルを取得
    For Each idx In SortDatesDescending()
        
        ' インデックス、更新日時、ファイル名を表示（確認用）
        Debug.Print idx, f(idx).Date, f(idx).Name
        
        ' 以下にファイル毎の処理を記載して活用する
        ' 例えば、ファイルを開く処理
        Set wb = Workbooks.Open(fpath & "\" & f(idx).Name)
        
        
    Next idx
    
    Application.ScreenUpdating = True
    Erase f
    
End Sub

Private Function SortDatesDescending() As Variant()
    Dim arr() As Variant
    Dim i As Long
    
    ReDim arr(1 To UBound(f), 1 To 2) As Variant
    
    For i = 1 To UBound(f)
        arr(i, 1) = i
        arr(i, 2) = f(i).Date
    Next i
    
    ' 日付を降順にソート
    Call QuickSortDescending(arr, LBound(arr), UBound(arr))
    
    ' 二次元配列の指定列(A列(1列目))を一次元配列に格納する
    SortDatesDescending = WorksheetFunction.Index(WorksheetFunction.Transpose(arr), 1)
    
End Function

Sub QuickSortDescending(ByRef arr As Variant, ByVal left As Long, ByVal right As Long)
    Dim i As Long, j As Long
    Dim pivot As Variant
    Dim temp1 As Variant
    Dim temp2 As Variant
    
    i = left
    j = right
    pivot = arr((left + right) \ 2, 2)
    
    Do While i <= j
        Do While arr(i, 2) > pivot
            i = i + 1
        Loop
        
        Do While arr(j, 2) < pivot
            j = j - 1
        Loop
        
        If i <= j Then
            temp1 = arr(i, 1)
            temp2 = arr(i, 2)
            arr(i, 1) = arr(j, 1)
            arr(i, 2) = arr(j, 2)
            arr(j, 1) = temp1
            arr(j, 2) = temp2
            
            i = i + 1
            j = j - 1
        End If
    Loop
    
    If left < j Then
        QuickSortDescending arr, left, j
    End If
    
    If i < right Then
        QuickSortDescending arr, i, right
    End If
End Sub