VBA100本ノック 84本目：ブックの自動バックアップ

公開日：2021-02-09　最終更新日：2021-02-10

VBA100本ノック 84本目：ブックの自動バックアップ

ブックが保存される時に自動的にバックアップを作成し30世代だけ残す問題です。

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

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

#VBA100本ノック 84本目
ブックが閉じられる時に自動的にバックアップを作成してください。
Thisworkbookパスの下の"BACKUP"フォルダに作成。
ブック名_yymmddhhmmss.xlsm
最新の30世代だけを残し、それより古いバックアップは削除してください。
※当該ファイル以外は存在しません。

訂正です。
誤：閉じられる
正：保存される
イベントBeforeSaveに実装してください。

再度訂正です｡
要件としては､万一のためのバックアップを30世代確保することです｡
イベントは､BeforeSave､AfterSaveどちらでも構いません｡

VBA作成タイム

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

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

頂いた回答

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

解説

出題が右往左往しましたが、とにかく自動でバックアップを作成して30世代確保します。
1秒単位なので数が多くなるので、連続して保存した時はバックアップを取らないようにSavedで判定しています。
BeforeSaveなら保存前の制御が可能です。AfterSaveなら保存されたかの確認ができます。


  
    
      Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

      　　If ThisWorkbook.Saved Then Exit Sub

      　　Call VBA100_84_01(Me)

End Sub


  
    
      Sub VBA100_84_01(ByVal wb As Workbook)

　　Dim sPath As String: sPath = wb.Path & "\BACKUP"

　　Dim fso As New Scripting.FileSystemObject

　　Dim oFile As Scripting.File

　　If Not fso.FolderExists(sPath) Then fso.CreateFolder (sPath)

　　

　　Dim ary

　　For Each oFile In fso.GetFolder(sPath).Files

　　　　Call insertArray(ary, oFile.Name)

　　Next

　　

　　Dim i As Long

      　　For i = LBound(ary) To UBound(ary) - 30

      　　　　fso.DeleteFile sPath & "\" & ary(i), True

　　Next

　　

　　Dim sFile As String

　　sFile = Replace(wb.Name, ".xlsm", Format(Now(), "_yyyymmddhhmmss")) & ".xlsm"

　　wb.SaveCopyAs sPath & "\" & sFile

　　

　　Set fso = Nothing

End Sub


      Sub insertArray(ByRef ary, ByVal aIn As Variant)

　　If IsEmpty(ary) Then

　　　　ReDim ary(0): ary(0) = aIn

　　　　Exit Sub

　　End If

　　

　　Dim i As Long

　　ReDim Preserve ary(UBound(ary) + 1)

　　For i = UBound(ary) - 1 To LBound(ary) Step -1

　　　　If aIn > ary(i) Then

　　　　　　ary(i + 1) = aIn

　　　　　　Exit Sub

　　　　End If

　　　　ary(i + 1) = ary(i)

　　Next

　　ary(LBound(ary)) = aIn

End Sub

30世代前の判定には、FSOで取得しながら順次ソートしています。
ファイル名でソートされて取得されるのが基本なので、ほぼそのまま詰みあがっていきます。
順序が違う場合のみソートに入れば良いので挿入ソートを使いました。
補足はありません。

補足

上記では- 30なので、この時点で30個が残ります。
その後に最新のバックアップが作られるので31個残ることになります。
問題文では30世代としているので、ここは-31が正解になります。
ただ、VBAを書きながらこのロジックの場合では、
30世代確保した上で最新バックアップを作ったほうが良いかなと思ってこのようにしてみました。
最新のバックアップがちゃんと作られるかの補償が無いからです。

むしろ、最新のバックアップを作り、それをinsertArrayで入れてから、DeleteFileしたほうが良いかもしれません。


  
    
      Sub VBA100_84_01(ByVal wb As Workbook)

　　Dim sPath As String: sPath = wb.Path & "\BACKUP"

　　Dim fso As New Scripting.FileSystemObject

　　Dim oFile As Scripting.File

　　If Not fso.FolderExists(sPath) Then fso.CreateFolder (sPath)

　　

　　Dim ary

　　For Each oFile In fso.GetFolder(sPath).Files

　　　　Call insertArray(ary, oFile.Name)

　　Next

　　

　　Dim sFile As String

　　sFile = Replace(wb.Name, ".xlsm", Format(Now(), "_yyyymmddhhmmss")) & ".xlsm"

　　wb.SaveCopyAs sPath & "\" & sFile

　　Call insertArray(ary, sFile)

　　

　　Dim i As Long

　　For i = LBound(ary) To UBound(ary) - 30

　　　　fso.DeleteFile sPath & "\" & ary(i), True

　　Next

　　

　　Set fso = Nothing

End Sub

サイト内関連ページ

第124回．Workbookのイベントプロシージャー

・Workbookのイベント一覧・イベントプロシージャー追加のVBE操作・Workbook_Open：Workbookのイベント・Workbook_BeforeClose：Workbookのイベント・Workbook_SheetChange：Workbookのイベント

第125回．Worksheetのイベントプロシージャー

・Worksheetのイベント・イベントプロシージャー追加のVBE操作・Activate：Worksheetのイベント・BeforeDoubleClick：Worksheetのイベント・BeforeRightClick：Worksheetのイベント・Change：Worksheetのイベント・SelectionChange：Worksheetのイベント・全てのシートまたは複数のシートに対するイベント

ブックが閉じる時に自動実行（Workbook_BeforeCloseとAuo_Close）

・Workbook_BeforeClose ・Auto_Close ・Workbook_BeforeCloseとAuto_Closeの実行順序・Workbook_BeforeCloseとAuto_Closeの違い

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

81本目：全フィルターの絞り込解除

・出題・頂いた回答・解説・補足・サイト内関連ページ

82本目：ブックのドキュメントプロパティを取得

・出題・頂いた回答・解説・補足・サイト内関連ページ

83本目：請求書を作成してPDF出力

・出題・頂いた回答・解説・補足・サイト内関連ページ

84本目：ブックの自動バックアップ
85本目：請求日から入金予定日を算出

・出題・頂いた回答・解説・補足・サイト内関連ページ

86本目：全シートの総当たり表を作成

・出題・頂いた回答・解説・補足・サイト内関連ページ

87本目：数式のシート間の依存関係

・出題・頂いた回答・解説・補足・サイト内関連ページ

88本目：クロスABC分析作成

・出題・頂いた回答・解説・補足・サイト内関連ページ

89本目：2つのフォルダの統合

・出題・頂いた回答・解説・補足・サイト内関連ページ

90本目：セルに重なっている画像の削除

・出題・頂いた回答・解説・補足・サイト内関連ページ

91本目：時間計算（残業時間の月間合計）

・出題・頂いた回答・解説・補足・サイト内関連ページ

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
84本目：ブックの自動バックアップ

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

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

VBA練習問題
VBA100本ノック 84本目：ブックの自動バックアップ