自動バックアップ　プログラム（その１）

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

自動バックアップ　プログラム（その２）へ続きます。

自動バックアップ　プログラム（その２）

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

waq3-travelog.com

2017.03.25