自動バックアップ プログラム(その1)

スポンサーリンク

Accessファイルを自動的にバックアップするプログラムを紹介します。

このプログラムを組み込んだAccessファイルを起動すると、Accessファイルと同一フォルダ内に「Backup」フォルダを作成し、その中に「DailyBackup」フォルダを作成します。

その後、自身のコピーを「DailyBackup」フォルダへコピーします。

このとき、自身のファイル名の先頭にバックアップした日付を付してコピーします。

コピーが実行されるのは、その日最初にそのファイルを起動したときだけです。

また、「DailyBackup」内に「日付+自身のファイル名」が5個以上存在したとき、直近5ファイルを除き削除します。

使用にあたっての注意点

このプログラムは、公開にあたりテストしておりますが、利用された際になんらかの損害が生じても責任を負いません。そちらの環境で十分テストのうえご利用ください。

こちらに同意される方は、自由に使用、変更していただいて結構です。

テーブル操作にDAO(データアクセスオブジェクト)を使用しております。

Access 2000、Access2002 での使用の際は、Microsoft DAO 3.x Object Library に参照設定して、優先順位を上げれるだけ上げておいてください。

ファイルコピーに、コマンドプロンプトのコピーコマンドを使用しています。

このため、コピー実行時に、コマンドプロンプトの黒い画面が出現します。

気になる方は、WindowsAPIのコピーを使用するなどしてください。

また、コマンドプロンプトへのパスを %ComSpec% で取得しています。

使用される際は、そちらの環境で十分テストのうえ使用してください。

Option Compare Database
Option Explicit

Function start_DailyBackup()

Call DailyBackup
End Function


Public Sub DailyBackup()

Dim fso As Object
Dim strTgtFile As String
Dim BakFileType As String
Dim BakFilename As String

'Access 2000,Access2002 ではMicrosoft  DAO 3.x Object Library に参照設定のこと
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String

Dim MotoFolderPath As String
Dim MotoFileNM As String

Dim BakFolderPath As String
Dim BakFileNM As String
Dim BakTime As String

Dim oShell As Object

Dim GET_FileNM As String

Dim L_cnt As Long  'ループカウンタ

On Error Resume Next

'バックアップされるファイル名
MotoFileNM = Application.CurrentProject.Name

'バックアップされるファイルがあるフォルダ
MotoFolderPath = Application.CurrentProject.Path

'バックアップを取得した時間
BakTime = Format(Now, "yyyy.mm.dd")

'バックアップ出力先ファイルパス
'フォルダがない時は、フォルダを作成
BakFolderPath = Application.CurrentProject.Path & "\Backup"

If Dir(BakFolderPath, vbDirectory) = "" Then MkDir BakFolderPath

BakFolderPath = BakFolderPath & "\DailyBackup"

If Dir(BakFolderPath, vbDirectory) = "" Then MkDir BakFolderPath


'##########################################
'出力先に同名のファイルがなければ実行
'###########################################


'バックアップ先出力ファイル名
BakFileNM = BakTime & "-" & MotoFileNM

If Dir(BakFolderPath & "\" & BakFileNM) = "" Then
    
    'ファイルコピー
    Set oShell = CreateObject("WScript.Shell")
        oShell.Run "%ComSpec% /c copy " & Chr(34) & MotoFolderPath & "\" & MotoFileNM & Chr(34) & " " & Chr(34) & BakFolderPath & "\" & BakFileNM & Chr(34), , True
    Set oShell = Nothing
End If


'FilePathテーブルから全レコード削除

Set db = CurrentDb

'FilePathテーブルが存在していなければ作成
'アクセスのシステムテーブル「MSysObjects」中に「FilePath」というテーブルの個数をカウント
If DCount("*", "MSysObjects", "Name='FilePath' and Type=1") = 0 Then
    
    strSQL = "create table FilePath (BakFilePath text)"
    db.Execute strSQL
End If

strSQL = "delete * from FilePath"
db.Execute strSQL

'DailyBackupフォルダ内のファイルパスをFilePathテーブルへ追加

'バックアップ先出力ファイル名
BakFileNM = "*" & MotoFileNM

GET_FileNM = Dir(BakFolderPath & "\" & BakFileNM)

Do While GET_FileNM <> ""

    strSQL = "insert into FilePath(BakFilePath) values('" & BakFolderPath & "\" & GET_FileNM & "')"
    
    db.Execute strSQL
    GET_FileNM = Dir
Loop

'ファイル名を降順に並び変え、直近5ファイルを除き削除

strSQL = "select * from FilePath order by BakFilePath desc"
Set rst = db.OpenRecordset(strSQL)
L_cnt = 1

If rst.RecordCount <> 0 Then
    Do
    
        'ファイル削除
        If L_cnt > 5 Then Kill rst!BakFilePath
        
        L_cnt = L_cnt + 1
        rst.MoveNext
    Loop Until rst.EOF = True
End If
rst.Close


'FilePathテーブル全レコード削除

strSQL = "delete * from FilePath"
db.Execute strSQL

End Sub

自動バックアップ プログラム(その2)へ続きます。

自動バックアップ プログラム(その2)
プログラムの組み込みについてAccess2016を用いて説明します。 自動バックアップ プログラム(その1)からの続きです。 手順1 適当なフォルダにアクセスファイル(空のデータベース)を作成します。 ここでは、TEST.accdbとします...

コメントをどうぞ!

  1. より:

    参考にさせていただきました。ありがとうございます。
    最終的に動きましたが、コードを掲載された際に文字化けの影響が生じているようです。

    1.BakFolderPathの指定に¥記号脱落

    2.<>記号が&lt;&gt;になっている
     Do While GET_FileNM
     If rst.RecordCount
     If L_cnt の後

    3.ファイルコピーoShell.Runにおいて”¥”の¥記号が脱落し””になっている

    • 和休 和休 より:

      Aさん、貴重なコメントをいただきまして、ありがとうございました。
      また、コードのご利用ありがとうございます。

      HTMLエスケーブというのですが、VBAのコードがHTMLで表示できるように変換できていなかったことが、原因のようです。

      さっそくコードを訂正しました。

  2. はる999 より:

    参考にさせていただきました。
    ちょっと改造して、フォルダーごとバックアップを取って、
    古い(直近5日以上前)フォルダーごと削除されるようにして使用しております。
    とても有益な記事をありがとうございました。

    • 和休 和休 より:

      はる999さん、コメントありがとうございます。
      お役に立てたようでなによりです。

      フォルダーごとバックアップ、とはいいアイデアですね。
      私もやってみたいと思います。

タイトルとURLをコピーしました