Access Tips #687 日付と連番を付けてファイルをバックアップするには？

Public Sub DBBackUp()

  'バックアップ元DBのフルパス
  Const cstrSrcDBPath As String = "C:\テスト\Database1.accdb"
  'バックアップ先のフォルダ
  Const cstrBackUpDir As String = "C:\テスト\BackUp\"
  Dim strSrcDBName As String
  Dim strBackUpDef As String
  Dim strBackUpPath As String
  Dim intDelm1 As Integer, intDelm2 As Integer
  Dim iintLoop As Integer
  Const cRetryMax As Integer = 100  '同日に可能な最大バックアップ回数

  'バックアップ元DBのファイル名部分だけを取り出し
  intDelm1 = InStrRev(cstrSrcDBPath, "\")
  intDelm2 = InStrRev(cstrSrcDBPath, ".accdb")
  strSrcDBName = Mid$(cstrSrcDBPath, intDelm1 + 1, intDelm2 - intDelm1 - 1)

  'バックアップ先ファイル名を初期設定
  strBackUpDef = cstrBackUpDir & strSrcDBName & "_" & Format$(Date, "yyyy-mm-dd")

  '同名ファイルがすでにないか確認する試行ループ
  For iintLoop = 0 To cRetryMax
    'カッコ付きで連番を付加してバックアップ先のフルパスを組み立て
    strBackUpPath = strBackUpDef & IIf(iintLoop = 0, "", "_(" & iintLoop & ")") & ".accdb"
    'そのファイルの存在をチェック
    If Len(Dir(strBackUpPath)) = 0 Then
      '存在していなければバックアップを実行
      FileCopy cstrSrcDBPath, strBackUpPath
      'バックアップしたら試行ループを抜ける
      Exit For
    End If
  Next iintLoop

End Sub


#687	日付と連番を付けてファイルをバックアップするには？	VBA
同じ日に何度もAccessのデータベースファイルをバックアップする場合に、そのバックアップ先のファイル名を「Database1_2020-07-22.accdb」、「Database1_2020-07-22_(1).accdb」、「Database1_2020-07-22_(2).accdb」・・・・のような感じで、『日付と連番』を付けて保存するプログラム例です。連番の付け方は、その日最初のバックアップでは日付のみ付加、２つめのファイルから(1)・(2)・(3)・・・というようにカッコ付きで番号を振ります。これは、Accessのマニュアル操作の[名前を付けて保存]-[データベースのバックアップ]の動作と同じ命名方法です。ここでは説明を簡単にするため、バックアップ元のファイル名とバックアップ先のフォルダ名は定数で固定しておくものとします。またバックアップ先のフォルダもすでに作成されているものとします。実際に使う際は、バックアップ元をカレントデータベースとしたりあるいはプロシージャの引数としたり、またフォルダがなければこの処理上で作成するなどしてアレンジしてみてください。 Public Sub DBBackUp() 'バックアップ元DBのフルパス Const cstrSrcDBPath As String = "C:\テスト\Database1.accdb" 'バックアップ先のフォルダ Const cstrBackUpDir As String = "C:\テスト\BackUp\" Dim strSrcDBName As String Dim strBackUpDef As String Dim strBackUpPath As String Dim intDelm1 As Integer, intDelm2 As Integer Dim iintLoop As Integer Const cRetryMax As Integer = 100 '同日に可能な最大バックアップ回数 'バックアップ元DBのファイル名部分だけを取り出し intDelm1 = InStrRev(cstrSrcDBPath, "\") intDelm2 = InStrRev(cstrSrcDBPath, ".accdb") strSrcDBName = Mid$(cstrSrcDBPath, intDelm1 + 1, intDelm2 - intDelm1 - 1) 'バックアップ先ファイル名を初期設定 strBackUpDef = cstrBackUpDir & strSrcDBName & "_" & Format$(Date, "yyyy-mm-dd") '同名ファイルがすでにないか確認する試行ループ For iintLoop = 0 To cRetryMax 'カッコ付きで連番を付加してバックアップ先のフルパスを組み立て strBackUpPath = strBackUpDef & IIf(iintLoop = 0, "", "_(" & iintLoop & ")") & ".accdb" 'そのファイルの存在をチェック If Len(Dir(strBackUpPath)) = 0 Then '存在していなければバックアップを実行 FileCopy cstrSrcDBPath, strBackUpPath 'バックアップしたら試行ループを抜ける Exit For End If Next iintLoop End Sub 【プログラムのポイント】まず「intDelm1 =～～～」からの３行でバックアップ元DBのファイル名部分だけを取り出し、それを変数strSrcDBNameにセットします。ここではファイルのフルパスは「C:\テスト\Database1.accdb」ですので、１行目で最後の「\」の位置が、２行目で最後の「.（ドット）」の位置が取得されます。そして３行目で「Mid$」関数を使うことで変数strSrcDBNameには「Database1」という値がセットされることになります。次に、バックアップ先ファイル名の初期値、つまりその日最初のバックアップのファイル名部分を組み立てます。ただし正確には「フルパスから拡張子を除いた部分」です。たとえば「C:\テスト\BackUp\Database1_2020/07/22」といった値が変数strBackUpDefにセットされます。次がこのプログラムの大きなポイントとなりますが、いきなりファイル名を「Database1_2020-07-22_(1).accdb」、「Database1_2020-07-22_(2).accdb」といったように決めてからバックアップするのではなく、「(1)がすでにあったら(2)」、「(2)がすでにあったら(3)」というように、毎回毎回連番の先頭から既存ファイルの有無をチェック・試行しながら、次にバックアップすべきファイル名を設定していきます。その全体を処理しているのが「For ～ Next」のループになります。「strBackUpPath = strBackUpDef & IIf(～～～」の行では、すでに組み立てられているバックアップファイル名に連番および拡張子を結合してフルパスを組み立てています。たとえば変数strBackUpDefの値が「C:\テスト\BackUp\Database1_2020/07/22」だったとき、変数strBackUpPathの値は次のように遷移します。１回目のループでは「iintLoop = 0」なので連番は付けず（IIf関数で分岐処理）、「C:\テスト\BackUp\Database1_2020/07/22.accdb」２回目のループでは、「C:\テスト\BackUp\Database1_2020/07/22_(1).accdb」３回目のループでは、「C:\テスト\BackUp\Database1_2020/07/22_(2).accdb」次の行では、変数strBackUpPathにセットされたファイルがすでにあるかどうかを「Dir」関数でチェックします。その返り値が”長さゼロ”の文字列ならファイルは存在しないことになりますので、「FileCopy」ステートメントを使って単純にファイルをバックアップ元からバックアップ先へコピーします。そしてループを抜けて処理を完了します。一方、”長さゼロ”の文字列でなければすでにファイルが存在していることになりますので、ファイルのコピーはせず、ループを次の番号を進めて同様の処理を続行します。なおここでは、コードの書き方として無限ループにならないよう、ループの上限を定数cRetryMaxで「100」としています。ここではそれを超えた場合の警告メッセージなども記述してありません。実際にそれ以上の回数が同日に実行される可能性がある場合には、適宜、もっと大きな値を定数に設定してなどします。実行例：
\| Index \| Prev \| Next \|