自動バックアップ プログラム(その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  Recordset
Dim strSQL As String

Dim MotoFolderPath, MotoFileNM As  String
Dim BakFolderPath, 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)へ続きます。

コメントをどうぞ!