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

最終更新日：2021-01-13

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

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

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

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

出題

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

頂いた回答

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

解説

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技術解説

VBAでワークシート関数が使えるのはとても便利です。WorksheetFunctionのシート関数を使う事は多いですが、配列を引数に指定した場合は要素数に制限があります。この制限があることは、ワークシート関数だという事を考えれば仕方ないのかもしれません。

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

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

サイト内関連ページ

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

同種のオブジェクトを複数まとめたものを「コレクション」と呼びます、コレクションもオブジェクトの一種です。例えば、Workbookオブジェクトが複数まとまったものは「Workbooksコレクション」Worksheetオブジェクトが複数まとまったものは「Worksheetsコレクション」オブジェクト名が単数形であるのに対し、

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

VBAでは、フォルダのファイル一覧を取得したりファイルの存在確認をする事が出来ます、Dir関数は、指定したパターン（ワイルドカード）やファイル属性と一致するファイルまたはフォルダの名前を表す文字列の値を返します。引数に指定したファイルが存在すると、そのファイル名を返し存在しないと空欄を返します。

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

VBAではファイル操作するためのステートメントと関数が多数用意されています、VBAでファイル操作する場合は、これらの用意されたステートメントや関数を使い処理を実現します。ファイル操作で使う、ステートメントと関数 ChDriveステートメント ChDirステートメント CurDir関数 MkDirステートメント RmDirステートメント Killステートメ…

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

FileSystemObjectオブジェクトでは、コンピュータのファイルシステムへのアクセスが提供されています。VBAに用意されているファイル操作関連のステートメントや関数より、より強力で、より多くの機能が搭載されています。ただし機能が大変多いため、これらを全て覚えるという事は困難です。

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

「Dictionaryオブジェクトについて簡単な使用例を上げて解説して欲しいです。」との要望をいただいたので、Dictionaryについて基本的な使い方を解説します。Dictionary（ディクショナリー）は名前の通り、辞書機能であり、連想配列とも呼ばれます。

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

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.マクロって何？VBAって何？｜VBA入門
5.Excelショートカットキー一覧｜Excelリファレンス
6.繰り返し処理（For Next)｜VBA入門
7.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
8.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
9.セルに文字を入れるとは（Range,Value）｜VBA入門
10.とにかく書いてみよう（Sub,End Sub）｜VBA入門

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

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

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

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