ACCESS程序設計備份還原功能輕松實現(xiàn)

1、ACCESS程序設計備份還原功能輕松實現(xiàn)數(shù)據備份與還原功能在一個系統(tǒng)中是不可或缺的功能，在ACCESS中只要通過簡單的幾步驟就可以作出很專業(yè)的數(shù)據備份與還原功能。下面就簡單的介紹制作的方法。一、 拆分數(shù)據庫：將數(shù)據庫拆分為兩個文件，其中一個專門儲存基本表，另一個儲存窗體、查詢、報表、數(shù)據表等內容。這個使用ACCESS的拆分向導就可以很輕松的完成，如下圖：拆分數(shù)據庫有幾個方面的好處：1、 利于以后將單機版本升級為網絡版。2、 利于程序的升級與數(shù)據備份的方便。二、 添加模塊：將以下代碼添加到模塊中，在窗體的代碼中將用到這部分模塊。只要在模塊面版中單擊新建按鈕，然后將以下代碼拷貝進去就可以了。具體的

2、代碼意思可以不必管它，只要能夠實現(xiàn)備份還原功能就可以了。如下圖：Option ExplicitType tagOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long strFilter As String strCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long strFile As String nMaxFile As Long strFileTitle As String nMaxFileTitle As Long strIni

3、tialDir As String strTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer strDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As StringEnd TypePrivate Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (ofn

4、As tagOPENFILENAME) As BooleanPrivate Declare Function apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ofn As tagOPENFILENAME) As BooleanPublic Function CommonFileOpenSave( _ Optional ByRef flags As Variant, _ Optional ByVal InitialDir As Variant, _ Optional ByVal

5、 Filter As Variant, _ Optional ByVal FilterIndex As Variant, _ Optional ByVal DefaultExt As Variant, _ Optional ByVal Filename As Variant, _ Optional ByVal DialogTitle As Variant, _ Optional ByVal hWnd As Variant, _ Optional ByVal OpenFile As Variant) As VariantDim ofn As tagOPENFILENAMEDim strFilen

6、ame As StringDim strFileTitle As StringDim fResult As BooleanDim strErrNotes As String On Error GoTo CommonFileOpenSave_Error If IsMissing(InitialDir) Then InitialDir = CurDir If IsMissing(Filter) Then Filter = "數(shù)據文件（*.mdb）" If IsMissing(FilterIndex) Then FilterIndex = 1 If IsMissing(flags

7、) Then flags = 0& If IsMissing(DefaultExt) Then DefaultExt = "" If IsMissing(Filename) Then Filename = "" If IsMissing(DialogTitle) Then DialogTitle = "" If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp If IsMissing(OpenFile) Then OpenFile = True strFilename

8、 = Left(Filename & String$(255, 0), 255) strFileTitle = String$(255, 0) With ofn .lStructSize = Len(ofn) .hwndOwner = hWnd .strFilter = Filter .nFilterIndex = FilterIndex .strFile = strFilename .nMaxFile = Len(strFilename) .strFileTitle = strFileTitle .nMaxFileTitle = Len(strFileTitle) .strTitle

9、 = DialogTitle .flags = flags .strDefExt = DefaultExt .strInitialDir = InitialDir .hInstance = 0 .strCustomFilter = String(255, 0) .nMaxCustFilter = 255 .lpfnHook = 0 End With If OpenFile Then fResult = apiGetOpenFileName(ofn) Else fResult = apiGetSaveFileName(ofn) End If If fResult Then If Not IsMi

10、ssing(flags) Then flags = ofn.flags CommonFileOpenSave = TrimNull(ofn.strFile) Else CommonFileOpenSave = Null End IfCommonFileOpenSave_WrapUp: Exit FunctionCommonFileOpenSave_Error: CommonFileOpenSave = Null GoTo CommonFileOpenSave_WrapUpEnd FunctionPublic Function AddFilterItem(strFilter As String,

11、 _ strDescription As String, Optional varItem As Variant) As StringDim strErrNotes As String If IsMissing(varItem) Then varItem = "*.*" AddFilterItem = strFilter & _ strDescription & vbNullChar & _ varItem & vbNullCharEnd FunctionPrivate Function TrimNull(ByVal strItem As S

12、tring) As StringDim intPos As IntegerDim strErrNotes As String intPos = InStr(strItem, vbNullChar) If intPos > 0 Then TrimNull = Left(strItem, intPos - 1) Else TrimNull = strItem End IfEnd FunctionPublic Function IsFileName(strFilename As String) As BooleanDim myFileSys Set myFileSys = CreateObje

13、ct("Scripting.FileSystemObject") If IsNull(strFilename) Then IsFileName = False Else If myFileSys.FileExists(strFilename) Then IsFileName = True Else IsFileName = False End If End IfEnd FunctionPublic Function GetFileSize(strFilename As String) As LongDim myFileSys Set myFileSys = CreateOb

14、ject("Scripting.FileSystemObject") If IsNull(strFilename) Or Not IsFileName(strFilename) Then GetFileSize = 0 Else GetFileSize = myFileSys.GetFile(strFilename).Size End IfEnd FunctionPublic Function IsPathName(strPathName As String) As BooleanDim myFileSys Set myFileSys = CreateObject(&quo

15、t;Scripting.FileSystemObject") If IsNull(strPathName) Then IsPathName = False Else If myFileSys.FolderExists(strPathName) Then IsPathName = True Else IsPathName = False End If End IfEnd FunctionPublic Function CheckPathFull(ByVal strPath As String) As String CheckPathFull = strPath If Right(str

16、Path, 1) <> "" Then CheckPathFull = strPath & ""End Function以上代碼輸入完后保存該模塊，隨便起個名稱就可以了。三、 設計窗體：設計一個窗體來實現(xiàn)用戶調用備份功能。窗體的具體樣式可以按你自己喜歡的來制作，只要包含以下幾個控件：兩個文本框、兩個命令按鈕，名稱如下圖所示：說明：1、txtSourceDir : 說明備份的文件名稱，主要是顯示給用戶看，沒有具體的作用，也可以省去！2、txtDestionationDir : 選擇要備份的目標文件夾，既備份文件儲存的位置。3、 Cmdo

17、penDestionationDir : 命令按鈕，用戶單擊后可以彈出窗口讓用戶選擇備份目錄，用戶選擇后的目錄路徑將顯示在 txtDestionationDir 文本框中。4、 CmdBackup : 開始備份按鈕，用戶單擊后將測試用戶操作是否正確，正確將開始備份數(shù)據并顯示備份成功，如果錯誤將顯示錯誤信息。四、 為窗體添加代碼：在窗體設計界面單擊代碼按鈕，并將以下代碼拷貝進去。如下圖：Option Compare DatabaseOption ExplicitPrivate Const BIF_RETURNONLYFSDIRS = 1Private Const BIF_DONTGOBELOWD

18、OMAIN = 2Private Const MAX_PATH = 260Private Type BROWSEINFO hwndOwner As Long pidlRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As LongEnd TypePrivate Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) A

19、s LongPrivate Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPrivate Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongDim strSourceDir, str

20、DestinationDir As StringDim i As IntegerDim img(9) As ImagePublic Function OpenDirectoryTV(Optional odtvTitle As String) As String Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim tBrowseInfo As BROWSEINFO szTitle = odtvTitle lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList

21、) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) OpenDirectoryTV = sBuffer End IfEnd FunctionPrivate Sub Form_Load() Me.txtSourceDir = CurrentProject.Path & "" & "PoseSky_be.mdb"End SubPrivate S

22、ub cmdOpenDestinationDir_Click() Me.txtDestinationDir = OpenDirectoryTV()End SubPrivate Sub cmdBackup_Click()On Error GoTo Err_ccc '可以修改以下文件的名稱及目錄為你后臺數(shù)據表的位置即可If Not IsNull(Me.txtSourceDir) Then strSourceDir = Me.txtSourceDirIf Not IsNull(Me.txtDestinationDir) Then strDestinationDir = Me.txtDesti

23、nationDirIf Len(strSourceDir) > 0 And Len(strDestinationDir) > 0 Then If Me.txtDestinationDir Like "*" & "A:" & "*" Or Me.txtDestinationDir Like "*" & "a:" & "*" Then FileCopy CurrentProject.Path & "" &am

24、p; "PoseSky_be.mdb", _ Me.txtDestinationDir & "" & "數(shù)據備份.mdb" DoCmd.Close acForm, "數(shù)據備份" MsgBox "數(shù)據已成功備份！請取出軟盤 ", vbInformation + vbOKOnly, "備份完成！" Else FileCopy CurrentProject.Path & "" & "PoseSky_be.mdb"

25、;, _ Me.txtDestinationDir & "" & Format(Date, "yyyy.mm.dd") & ".mdb" DoCmd.Close acForm, "數(shù)據備份" MsgBox "數(shù)據已成功備份！", vbInformation + vbOKOnly, "備份完成！" AddhowDolog "數(shù)據備份" DoCmd.Close End IfElse MsgBox "目標文件路徑不能為空！&qu

26、ot;, vbExclamation + vbOKOnly, "警告"End IfExit_ccc: Exit SubErr_ccc: If err.Number = 70 Then MsgBox "錯誤號：" & err.Number & "。發(fā)生錯誤的原因可能是：" & Chr(10) & Chr(10) & "1.數(shù)據窗口未關閉；" & Chr(10) & "2.磁盤寫保護。", vbExclamation + vbOKOnly, &

27、quot;提示" Else MsgBox "錯誤號：" & err.Number & "。發(fā)生錯誤的原因是：" & err.Description, vbExclamation + vbOKOnly, "提示" End If Resume Exit_cccEnd SubPrivate Sub Form_Open(Cancel As Integer)End Sub注意要將以上代碼中的紅色部分改為你數(shù)據表的名稱。代碼輸入完畢后在VBA窗口中單擊調試菜單中的編譯命令，如果有出錯將在窗口中顯示。如下圖：五、

28、保存測試：以上工作完成后一個備份功能的窗體就完成了，你可以測試一下看是否能夠完成備份的功能。六、 還原功能：還原窗體的制作與備份功能的步驟差不多，給窗體名稱及代碼如下：Private Sub 開始還原_Click()On Error GoTo Err_csqIf Me.還原文件 = "" Or IsNull(Me.還原文件) Then MsgBox "您沒有選擇還原文件！", vbExclamation + vbOKOnly, "提示" Me.還原文件.SetFocusElse If MsgBox("還原將覆蓋原數(shù)據且不能恢復，" & Chr(10) & "請確認所選的文件是否正確。" & Chr(10) & Chr(10) & "如果選擇的文件正確，請按“確定”。" & Chr(10) & "否則，請按“取消”。", vbExclamation + vbOKCancel, "