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

VBAを100本の練習問題で鍛えます
最終更新日: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本目:リンクされた図(カメラ機能)


新着記事NEW ・・・新着記事一覧を見る

抜けている数値を探せ|エクセル雑感(2022-07-01)
.Net FrameworkのSystem.Collectionsを利用|VBA技術解説(2022-06-29)
迷路ネコが影分身の術を体得したら…|エクセル雑感(2022-06-27)
迷路にネコが挑戦したら、どうなるかな…|エクセル雑感(2022-06-26)
サロゲートペアに対応した自作関数(Len,Left,Mid,Right)|エクセル雑感(2022-06-24)
「マクロの登録」で登録できないプロシージャーは?|エクセル雑感(2022-06-23)
オブジェクトのByRef、ByVal、Variant|エクセル雑感(2022-06-22)
コメントから特定形式の年月を取り出す|エクセル雑感(2022-06-19)
4,9を使わない連番作成|エクセル雑感(2022-06-17)
連番を折り返して出力|エクセル雑感(2022-06-16)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.マクロって何?VBAって何?|VBA入門
8.並べ替え(Sort)|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.エクセルVBAでのシート指定方法|VBA技術解説




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


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



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