VBA100本ノック 57本目：ファイルの更新日時

公開日：2020-12-29　最終更新日：2021-01-13

VBA100本ノック 57本目：ファイルの更新日時

バックアップファイルの各更新日付の最終時刻のファイルだけを残し、他を削除する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。
ファイル名・拡張子を判定しないので、適当なファイルを"BACKUP"フォルダに集めて動作確認してください。

出題

#VBA100本ノック 57本目
マクロ自身と同階層の"BACKUP"フォルダに多数のバックアップが入っています。
同一の更新日については最終時刻のみを残して他を削除してください。
※つまり各更新日付の最終時刻のファイルだけ残る。
※(簡易版として)ファイル名・拡張子には関係なく更新日時のみで判断

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

Dictionaryに、
Key：更新日付
Item：更新日時とファイルパスの配列
同一キー（日付）が存在した場合は更新日時の大小を判定し削除対象かを決めます。
削除対象は順次Collectionに追加していき、最後にCollectionにあるファイルを削除しています。


  
    
      Sub VBA100_57_01()

      　　Dim objFso As New Scripting.FileSystemObject

　　Dim objFolder As Folder

　　Set objFolder = objFso.GetFolder(ThisWorkbook.Path & "\BACKUP")

　　Dim objFile As File

　　

　　Dim dic As New Dictionary

　　Dim col As New Collection

　　

　　Dim strDate As String, lastDt As Date

　　For Each objFile In objFolder.Files

　　　　lastDt = objFile.DateLastModified

　　　　strDate = Format(lastDt, "yyyymmdd")

　　　　If Not dic.Exists(strDate) Then

　　　　　　dic.Add strDate, Array(lastDt, objFile.Path)

　　　　End If

　　　　If lastDt > dic(strDate)(0) Then

　　　　　　col.Add dic(strDate)(1)

　　　　　　dic(strDate) = Array(lastDt, objFile.Path)

　　　　ElseIf lastDt < dic(strDate)(0) Then

　　　　　　col.Add objFile.Path

　　　　End If

　　Next

　　

　　On Error Resume Next

　　Dim vItem

　　For Each vItem In col

　　　　Err.Clear

　　　　objFso.DeleteFile vItem, True

　　　　If Err Then

　　　　　　Debug.Print "削除失敗：" & vItem & vbLf & Err.Description

　　　　End If

      　　Next

      　　

      　　'Set Nothingは省略

End Sub

方法はいろいろと考えられます。
更新日時で並べ替えて、日付ごとの最大更新日時を取得しても良いでしょう。
Dir → 配列 → Sort関数(365) → Kill
このVBAサンプルは記事補足に掲載しました。

補足

先のVBAは、
FileSystemObject + Dictionary + Collection

以下のVBAは、先のVBAとは対照的なVBAサンプルとして、
Dir + 配列 + Sort関数(365) + Kill
この組み合わせになります。


  
    
      Sub VBA100_57_02()

      　　Dim bkPath As String

      　　bkPath = ThisWorkbook.Path & "\BACKUP\"

      　　

      　　Dim ary(), cnt As Long

      　　Dim sFile As String

      　　sFile = Dir(bkPath)

      　　Do While sFile <> ""

      　　　　cnt = cnt + 1

      　　　　ReDim Preserve ary(1 To 2, 1 To cnt)

      　　　　ary(2, cnt) = bkPath & sFile

      　　　　ary(1, cnt) = Format(FileDateTime(ary(2, cnt)), "yyyymmdd hhmmss")

      　　　　sFile = Dir()

      　　Loop

      　　

      　　If cnt = 0 Then Exit Sub

      　　

      　　Dim aryS()

      　　With WorksheetFunction

      　　　　aryS = .Sort(.Transpose(ary))

      　　End With

      　　

      　　On Error Resume Next

      　　Dim i As Long, sDateTime As String

      　　sDateTime = aryS(UBound(aryS, 1), 1)

      　　For i = UBound(aryS, 1) - 1 To LBound(aryS, 1) Step -1

      　　　　If Split(aryS(i, 1))(0) = Split(aryS(i + 1, 1))(0) Then

      　　　　　　If aryS(i, 1) < sDateTime Then

      　　　　　　　　Err.Clear

      　　　　　　　　Kill aryS(i, 2)

      　　　　　　　　If Err Then

      　　　　　　　　　　Debug.Print "削除失敗：" & aryS(i, 2) & vbLf & Err.Description

      　　　　　　　　End If

      　　　　　　End If

      　　　　Else

      　　　　　　sDateTime = aryS(i, 1)

      　　　　End If

      　　Next

      End Sub

並べ替えについては、新関数を使わなくてもシートでやれば同じです。
ですが、並べ替えの為だけにシート出力するのはどうしてもVBA記述が面倒に感じてしまいます。
新関数が使えると、VBA記述がだいぶ変わってくると思います。
ただし、ワークシート関数には制限がありますのでご注意ください。

SORT関数、SORTBY関数（範囲を並べ替え）｜エクセル入門

・SORT関数の書式・SORTBY関数の書式・SORT関数、SORTBY関数と、ワークシートの並べ替えの違い・最も単純な並べ替え・複数キーでの並べ替え・列方向（横方向）で並べ替え・並べ替え範囲（配列）以外の基準で並べ替える・列全体を範囲指定する場合・スピルによって新しく追加された関数

VBAでシート関数使用時の配列要素数制限｜VBA技術解説

・FILTER関数・SORT関数、SORTBY関数・UNIQUE関数・XLOOKUP関数、HLOOKUP関数、VLOOKUP関数・XMATCH関数、MATCH関数・TRANSPOSE関数・VBAでシート関数使用時の配列要素数制限まとめ

動的2次元配列の次元を入れ替えてシートへ出力（Transpose）｜VBA技術解説

動的配列を使い様々な処理をした後にシートへ出力しようとしたとき、縦横が違っている為そのまま出力できません、そもそも、動的配列の要素数をRedimで変更できるのは、最下位の次元のみになります。2次元配列の場合、ReDimmyArray(2,10) ReDimmyArray(2,11) これはOKですが、

サイト内関連ページ

第58回．コレクションとは（Collection）

・コレクションの中から単一オブジェクトを指定する場合・セルであるRangeオブジェクトのコレクションは？・コレクションの要素数・Collectionオブジェクト

第79回．ファイル操作Ⅰ（Dir）｜VBA入門

・Dir関数・Dir関数の使用例・Dir関数の実践例・Dir関数の制限について・Dir関数の関連記事

第80回．ファイル操作Ⅰ（その他）｜VBA入門

・ファイル操作で使う、ステートメントと関数・ファイル操作の使用例・ファイル操作の実践例・ファイル操作について

第119回．ファイルシステムオブジェクト（FileSystemObject）｜VBA入門

・FileSystemObjectオブジェクトの使用方法・FileSystemObjectオブジェクトのプロパティとメソッド・FileSystemObjectオブジェクトのメソッドの戻り値・FileSystemObjectオブジェクトの使用例・FileSystemObjectオブジェクトの関連記事と実践例

Dictionary（ディクショナリー）連想配列の使い方について｜VBA技術解説

・Dictionaryを使って重複を除く・Dictionaryの使い方その2 ・Dictionaryの使い方その3 ・Dictionaryの使い方サンプル・サイト内のDictionary関連記事

同じテーマ「VBA100本ノック」の記事

54本目：シートのChangeイベント
 55本目：他ブックのマクロを起動
 56本目：数式内の自身のシート名を消す
57本目：ファイルの更新日時
58本目：番号リストを簡潔にした文字列で返す
 59本目：12ヶ月分のシートを四半期で分割
 60本目：「株式会社」の表記ゆれ置換
 61本目：「ふりがな」の取得と設定
 62本目：独自のZLOOKUP関数を作成
 63本目：複数シートの連結
 64本目：リンクされた図（カメラ機能）

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
57本目：ファイルの更新日時

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 57本目：ファイルの更新日時