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

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


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

VBA100本ノック 68本目:全テキストボックスの転記|VBA練習問題(1月16日)
VBA100本ノック 67本目:ComboBoxとListBox|VBA練習問題(1月15日)
VBA100本ノック 66本目:全サブフォルダからファイルを探す|VBA練習問題(1月13日)
VBA100本ノック 65本目:固定長テキスト出力|VBA練習問題(1月12日)
VBA100本ノック 64本目:リンクされた図(カメラ機能)|VBA練習問題(1月11日)
VBA100本ノック 63本目:複数シートの連結|VBA練習問題(1月9日)
VBA100本ノック 62本目:独自のZLOOKUP関数を作成|VBA練習問題(1月8日)
VBA100本ノック 61本目:「ふりがな」の取得と設定|VBA練習問題(1月6日)
VBA100本ノック 60本目:「株式会社」の表記ゆれ置換|VBA練習問題(1月5日)
VBA100本ノック 59本目:12ヶ月分のシートを四半期で分割|VBA練習問題(1月4日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.繰り返し処理(Do Loop)|VBA入門




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


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



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