MS Access VBA モジュール集(アクセス本体のバックアップをとる) -- Key：雑学事典

実行すると自動的にバックアップをとる関数。バックアップを何世代とるか、どのファイルをバックアップするか、どこに何て名前でバックアップするかを指定可能。ファイル名分解関数とフォルダ存在チェック関数を使用。とりあえずはAccessのバックアップ専用。

第一引数	世代(0 or 1 or 2)
第一引数	保存元ファイル名(フルパス指定)
第一引数	保存先ファイル名(フルパス指定)

Option Compare Database


Public Function FileBackUp(lngGer As Long, _
                           strFileFrom As String, _
                           strFileTo As String)
    Dim e As Integer
    Dim strNewPath As String, strNewName As String
    Dim strOldPath As String, strOldName As String
    Dim strMyName As String
    
    GetPathName strFileFrom
    strOldPath = strDrive & strDirectory
    strOldName = strFileName
    GetPathName strFileTo
    strNewPath = strDrive & strDirectory
    strNewName = strFileName

    DBEngine.CompactDatabase strFileFrom, strOldPath & "forRepair.mdb"
    Kill strFileFrom
    Name strOldPath & "forRepair.mdb" As strFileFrom
    
    If IsFolderExists(Mid(strNewPath, 1, _
                      Len(strNewPath) - 1)) = False Then
        MkDir (Mid(strNewPath, 1, Len(strNewPath) - 1))
    End If

    Select Case lngGer
        Case 0
            If ExistMDB(strNewPath & Mid(strNewName, 1, _
                        Len(strNewName) - 4) & "*") = True Then
                Kill (strNewPath & Mid(strNewName, 1, _
                        Len(strNewName) - 4) & "*")
            End If
        Case 1
            If ExistMDB(strNewPath & Mid(strNewName, 1, _
                        Len(strNewName) - 4) & "*") = True Then
                Kill (strNewPath & Mid(strNewName, 1, _
                      Len(strNewName) - 4) & "*")
            End If
            Call CopyMDB(strOldPath & strOldName, strNewPath _
                         & Mid(strNewName, 1, Len(strNewName) - 4) & "_1.mdb")
        Case 2
            If ExistMDB(strNewPath & Mid(strNewName, 1, _
                        Len(strNewName) - 4) & "_2.mdb") = True Then
                Kill (strNewPath & Mid(strNewName, 1, _
                      Len(strNewName) - 4) & "_2.mdb")
            End If
            If ExistMDB(strNewPath & Mid(strNewName, 1, _
                        Len(strNewName) - 4) & "_1.mdb") = True Then
                Call CopyMDB(strNewPath & Mid(strNewName, 1, _
                             Len(strNewName) - 4) & "_1.mdb", strNewPath _
                             & Mid(strNewName, 1, Len(strNewName) - 4) & "_2.mdb")
                Kill (strNewPath & Mid(strNewName, 1, _
                      Len(strNewName) - 4) & "_1.mdb")
            End If
            Call CopyMDB(strOldPath & strOldName, strNewPath _
                         & Mid(strNewName, 1, Len(strNewName) - 4) & "_1.mdb")
    End Select
End Function



Private Function CopyMDB(strOldMDB As String, strNewMDB As String)
    FileCopy strOldMDB, strNewMDB
End Function



Private Function ExistMDB(strFile As String) As Boolean
    If Len(Dir(strMyPath2 & strFile)) = 0 Then
        ExistMDB = False
    Else
        ExistMDB = True
    End If
End Function

アクセス本体のバックアップをとる

解説

引数・戻値

ソース

このページに関するご案内