トリフラットで行こう

VBAやVBEを中心に。

指定したフォルダ内の全ファイルの更新日時を変更する(VBA)

最近はVBAから少し離れていたこともあり久しぶりの更新です。
(1年以上の空白期間...)

さて、最近私は大量のファイルを整理する役目を担っております。
その中で更新日時を指定の日付に変更するというものがありまして
100以上のファイルがあるのでさすがに一つ一つやるというのは無理でして、、
VBAスクリプトを組んでみました。

スクリプトを動作させるには参照設定に追加のチェックが必要です。(本当はなしでやりたかったけどなぜかできなかった。)

参照設定
Option Explicit

' 参照設定をオンにすること(以下の2項目)
' Microsoft Scripting Runtime
' Microsoft Shell Controls And Automation

' グローバル変数
Dim fcount As Long

Public Sub main()
    ' カウンタ変数初期化
    fcount = 0
    ' ダイアログでフォルダを選択する
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            SubFolderPick (CStr(.SelectedItems(1)))
            MsgBox "処理終了" & vbLf & "処理ファイル数:" & fcount
        End If
    End With
End Sub

' すべてのサブフォルダに対して処理を実行(引数:フォルダ名(文字列))
Private Sub SubFolderPick(fpath As String)
    Dim fso As New Scripting.FileSystemObject
    Dim fol As Scripting.Folder
    
    'まずは親フォルダにのファイルに処理を実行
    changeKoshin (fpath)
    
    'フォルダ内のすべてのサブフォルダをループ
    For Each fol In fso.GetFolder(fpath).SubFolders
        'サブフォルダに対して処理を実行
        changeKoshin (CStr(fol))
        ' 再帰呼び出し(サブフォルダのサブフォルダで実行)
        SubFolderPick (CStr(fol))
    Next
End Sub

' フォルダ内すべてファイルの更新日時を更新する処理(引数:フォルダ名(文字列))
Private Sub changeKoshin(fpath As String)
    Dim fso As New Scripting.FileSystemObject
    Dim shell As New Shell32.shell
    Dim files As Scripting.files
    Dim file As Scripting.file
    Dim folder_o As Shell32.Folder
    Dim file_o As Shell32.FolderItem
    
    ' フォルダ内のファイルたちを取得
    Set files = fso.GetFolder(fpath).files
    ' フォルダを取得(shell)
    Set folder_o = shell.Namespace(fpath)
    
    ' フォルダ内の全ファイルに対して
    For Each file In files
        Set file_o = folder_o.ParseName(file.Name) 'ファイルを取得
        file_o.ModifyDate = Now '更新日時を今に変更
    Next
    '処理したファイル数を加算
    fcount = fcount + files.Count
    
    ' 後処理
    Set files = Nothing
    Set fso = Nothing
    Set shell = Nothing
    Set folder_o = Nothing
    Set file_o = Nothing 
End Sub

Excelでマクロ(main)を実行するとフォルダ選択ウィンドウが現れます。
選択したフォルダ内にあるすべてのファイルの更新日時が現在時刻に変更されます。
ちなみに、サブフォルダ内にあるファイルもすべて変更が適用されます。