Accessのバックアップは、SQL ServerやOracle と違って通常はデータが入っているAccdbをコピーする、言ってみれば非常に手軽なもので、必要に応じてサーバーの特定のフォルダやバックアップ用の外付けハードディスク等に「コピー、貼り付け」するだけです。
ただし手軽な半面、手作業の場合は「いつバックアップするのか」「誰がバックアップするのか」「忘れる可能性がある」等、考慮しなければならないことはあります。
「ファイルコピー用スクリプトを作成して、タスクスケジューラで実行する」「Windowsのバックアップ機能を利用する」といったことも考えられますが、ここではAccessでバックアップする例を記載します。
Option Compare Database
Option Explicit
'**********************************************************************
' 機能：バックアップ処理
' 引数：なし
' 戻値：処理結果 (0=正常終了、1=バックアップ処理中、-1=異常終了)
'**********************************************************************
Public Function DbBackup() As Integer
On Error GoTo trap
Dim retCode As Integer
Dim Youbi As String ' 曜日のアルファベット先頭3文字
Dim BkFileName As String ' 今回のバックアップで作成されるバックアップファイル名
Dim BkFileName_Old As String ' 同じ曜日の前回に作成されたバックアップファイル名
Dim FSO As Object
Dim file As Object
Const C_WorkFolder As String = "XXXXX" ' データ用Accdb格納先フォルダ
Const C_BkFolder As String = "XXXXX" ' バックアップ先のフォルダ
' フォルダの最後には
を付けます。
Const C_DbName As String = "SampleDb.accdb" ' データ用Accdbの名前
Const C_TmpDbName As String = "db1.accdb" ' 一時Accdb名
Const C_CheckFileName As String = "bk_check.txt" ' バックアップチェック用ファイル
' バックアップ処理中を示すテキストファイルの存在チェック
' 存在していたら他の人がバックアップ処理中であるとみなす。
If Len(Dir(C_WorkFolder & C_CheckFileName)) > 0 Then
DbBackup = 1
Exit Function
End If
' 本日の曜日を取得
Youbi = GetYobi
' バックアップファイル名を生成(曜日 + 年月日時分秒 + _db.bak)
BkFileName = Youbi & Format(Now(), "yyyymmddhhnnss") & "_db.bak"
' 同じ曜日の前回のバックアップのパス
BkFileName_Old = Dir(C_BkFolder & "*.bak", vbNormal)
' 今回作成しようとしているバックアップファイルと先頭11桁が同じファイルの存在チェック
Do While BkFileName_Old <> ""
' 同じものが存在したら、本日のバックアップは処理済みとみなす。
If Left(BkFileName_Old, 11) = Left(BkFileName, 11) Then
DbBackup = 0
Exit Function
End If
BkFileName_Old = Dir
Loop
' バックアップ中のメッセージ表示用フォームを開く
DoCmd.OpenForm "BackUpMsg"
DoEvents
' バックアップ処理中を示すテキストファイルの作成
retCode = CheckFileCreator(C_WorkFolder & C_CheckFileName)
If retCode = -1 Then
DbBackup = -1
Exit Function
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
' 今回作成しようとしているバックアップファイルと先頭3桁が同じファイルを削除する｡
' ( = 同じ曜日の前回のバックアップファイルを削除)
BkFileName_Old = Dir(C_BkFolder & "*.bak", vbNormal)
Do While BkFileName_Old <> ""
If Left(BkFileName_Old, 3) = Left(BkFileName, 3) Then
Set file = FSO.Getfile(C_BkFolder & BkFileName_Old)
file.Delete
Exit Do
End If
BkFileName_Old = Dir
Loop
' バックアップ処理
FSO.copyfile C_WorkFolder & C_DbName, C_BkFolder & BkFileName
' 最適化処理
retCode = CompDb(C_WorkFolder & C_DbName, C_WorkFolder & C_TmpDbName)
If retCode = -1 Then
DbBackup = -1
Exit Function
End If
' バックアップ処理中を示すテキストファイルを削除
If Len(Dir(C_WorkFolder & C_CheckFileName)) > 0 Then
Set file = FSO.Getfile(C_WorkFolder & C_CheckFileName)
file.Delete
End If
' バックアップ中のメッセージ表示用フォームを閉じる
DoCmd.Close acForm, "BackUpMsg"
exit_trap:
Exit Function
trap:
MsgBox "[" & Err.Number & "] " & Err.Description & " => DbBackup"
DbBackup = -1
Resume exit_trap
End Function
'**********************************************************************
' 機能：バックアップ処理中を示すテキストファイルの作成
' 引数：テキストファイルのパス
' 戻値：処理結果 (0=正常終了、-1=異常終了)
'**********************************************************************
Private Function CheckFileCreator(ByVal FilePath As String) As Integer
On Error GoTo trap
Dim U_Name As String
Dim C_Name As String
Dim WSH As Object
'==============================
' [ファイルの中身] ※中身は空でも良い。
' 1. "バックアップ中"という文字列
' 2. 現在日時
' 3. ログインユーザー名
' 4. コンピュータ名
'==============================
' テキストファイルに書き込む情報のうち、ログインユーザー名とコンピュータ名を取得する。
Set WSH = CreateObject("WScript.Network")
U_Name = WSH.UserName
C_Name = WSH.ComputerName
Set WSH = Nothing
Open FilePath For Output As #1
Write #1, "バックアップ中", Now(), U_Name, C_Name
Close #1
exit_trap:
Exit Function
trap:
MsgBox "[" & Err.Number & "] " & Err.Description & " => CheckFileCreate"
Close #1
CheckFileCreator = -1
Resume exit_trap
End Function
'**********************************************************************
' 機能：最適化処理
' 引数：DBのパス
' 引数：一時DBのパス
' 戻値：処理結果 (0=正常終了、-1=異常終了)
'**********************************************************************
Private Function CompDb(ByVal DbPath As String, _
ByVal TmpDbPath As String) As Integer
On Error GoTo trap
Dim FSO As Object
Dim file As Object
' 最適化の一時mdbが存在している場合は削除(念の為)
If Dir(TmpDbPath) <> "" Then
Kill TmpDbPath
End If
' 最適化 (最適化したaccdbは一時ファイル名にする。ここでは「db1.accdb」)
DBEngine.CompactDatabase DbPath, TmpDbPath
' 元のAccdbを削除する (ここでは「SampleDb.accdb」)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file = FSO.Getfile(DbPath)
file.Delete
' 一時ファイルのAccdbを正式なファイル名に変更 (db1.accdb → SampleDb.accdb)
Name TmpDbPath As DbPath
exit_trap:
Exit Function
trap:
MsgBox "[" & Err.Number & "] " & Err.Description & " => CompDb"
CompDb = -1
Resume exit_trap
End Function
'**********************************************************************
' 機能：本日の曜日を取得
' 引数：なし
' 戻値：取得した曜日の略称
'**********************************************************************
Private Function GetYobi() As String
Dim Youbi As String
Select Case WeekdayName(WeekDay(Date))
Case "日曜日"
Youbi = "SUN"
Case "月曜日"
Youbi = "MON"
Case "火曜日"
Youbi = "TUE"
Case "水曜日"
Youbi = "WED"
Case "木曜日"
Youbi = "THU"
Case "金曜日"
Youbi = "FRI"
Case "土曜日"
Youbi = "SAT"
End Select
GetYobi = Youbi
End Function
Option Compare Database
Option Explicit
'**************************************************
' 開く時
'**************************************************
Private Sub Form_Open(Cancel As Integer)
Dim retCode As Integer
With Me
' 開く時に必要なコード
'==============================
' バックアップ処理
'==============================
retCode = DbBackup
If retCode = -1 Then
Cancel = True
Exit Sub
ElseIf retCode = 1 Then
MsgBox "バックアップ処理中です。" & vbCrLf _
& "しばらくしてから再度Accessを起動して下さい。",
vbOKOnly + vbCritical, "バックアップチェック"
DoCmd.Close acForm, .Name
Exit Sub
End If
' 開く時に必要なコード
End With
End Sub
