VBA100本ノック 57本目:ファイルの更新日時
バックアップファイルの各更新日付の最終時刻のファイルだけを残し、他を削除する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
ファイル名・拡張子を判定しないので、適当なファイルを"BACKUP"フォルダに集めて動作確認してください。
出題
マクロ自身と同階層の"BACKUP"フォルダに多数のバックアップが入っています。
同一の更新日については最終時刻のみを残して他を削除してください。
※つまり各更新日付の最終時刻のファイルだけ残る。
※(簡易版として)ファイル名・拡張子には関係なく更新日時のみで判断
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
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サンプルは記事補足に掲載しました。
補足
FileSystemObject + Dictionary + Collection
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記述がだいぶ変わってくると思います。
ただし、ワークシート関数には制限がありますのでご注意ください。
サイト内関連ページ
同じテーマ「VBA100本ノック」の記事
58本目:番号リストを簡潔にした文字列で返す
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 57本目:ファイルの更新日時
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。