ACCESS程序设计-备份还原功能轻松实现

1、ACCESS 程序设计备份还原功能轻松实现数据备份与还原功能在一个系统中是不可或缺的功能，在 ACCESS 中只要通过简单的几步骤就可以作出很专业的数据备份与还原功能。下面就简单的介绍制作的方法。一、 拆分数据库： 将数据库拆分为两个文件，其中一个专门储存基本表，另一个储存窗体、查询、报表、数据表等内容。这个使用 ACCESS 的拆分向导就可以很轻松的完成，如下图：拆分数据库有几个方面的好处：1、 利于以后将单机版本升级为网络版。2、 利于程序的升级与数据备份的方便。二、 添加模块： 将以下代码添加到模块中， 在窗体的代码中将用到这部分模块。 只要在模块面版中单击新建按钮， 然后将以下代码拷贝

2、进去就可以了。 具体的代码意思可以不必管它，只要能够实现备份还原功能就可以了。如下图：Option ExplicitType tagOPENFILENAMElStructSizeAs LonghwndOwnerAs LonghInstanceAs LongstrFilter As StringstrCustomFilter As StringnMaxCustFilter As LongnFilterIndex As LongstrFileAs StringnMaxFileAs LongstrFileTitle As StringnMaxFileTitle As LongstrInitialDi

3、r As StringstrTitleAs StringflagsAs LongnFileOffset As IntegernFileExtension As IntegerstrDefExtAs StringlCustDataAs LonglpfnHookAs LonglpTemplateName As StringEnd TypePrivateDeclareFunctionapiGetOpenFileNameLibcomdlg32.dllAliasGetOpenFileNameA (ofn As tagOPENFILENAME) As BooleanPrivateDeclareFuncti

4、onapiGetSaveFileNameLibcomdlg32.dllAliasGetSaveFileNameA (ofn As tagOPENFILENAME) As BooleanPublic Function CommonFileOpenSave( _Optional ByRef flags As Variant, _Optional ByVal InitialDir As Variant, _Optional ByVal Filter As Variant, _Optional ByVal FilterIndex As Variant, _Optional ByVal DefaultE

5、xt As Variant, _Optional ByVal Filename As Variant, _Optional ByVal DialogTitle As Variant, _Optional ByVal hWnd As Variant, _Optional ByVal OpenFile As Variant) As VariantDim ofnAs tagOPENFILENAMEDim strFilename As StringDim strFileTitle As StringDim fResultAs BooleanDim strErrNotes As StringOn Err

6、or GoTo CommonFileOpenSave_ErrorIf IsMissing(InitialDir) Then InitialDir = CurDirIf IsMissing(Filter) Then Filter = 数据文件（ *.mdb ） If IsMissing(FilterIndex) Then FilterIndex = 1If IsMissing(flags) Then flags = 0&If IsMissing(DefaultExt) Then DefaultExt = If IsMissing(Filename) Then Filename = If IsMi

7、ssing(DialogTitle) Then DialogTitle = If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp If IsMissing(OpenFile) Then OpenFile = True strFilename = Left(Filename & String$(255, 0), 255)strFileTitle = String$(255, 0)With ofn.lStructSize = Len(ofn).hwndOwner = hWnd.strFilter = Filter.nFilterIndex

8、 = FilterIndex.strFile = strFilename.nMaxFile = Len(strFilename).strFileTitle = strFileTitle.nMaxFileTitle = Len(strFileTitle).strTitle = DialogTitle.flags = flags.strDefExt = DefaultExt.strInitialDir = InitialDir.hInstance = 0.strCustomFilter = String(255, 0).nMaxCustFilter = 255.lpfnHook = 0End Wi

9、thIf OpenFile ThenfResult = apiGetOpenFileName(ofn)ElsefResult = apiGetSaveFileName(ofn)End IfIf fResult ThenIf Not IsMissing(flags) Then flags = ofn.flagsCommonFileOpenSave = TrimNull(ofn.strFile)ElseCommonFileOpenSave = NullEnd IfCommonFileOpenSave_WrapUp:Exit FunctionCommonFileOpenSave_Error:Comm

10、onFileOpenSave = NullGoTo CommonFileOpenSave_WrapUpEnd FunctionPublic Function AddFilterItem(strFilter As String, _strDescription As String, Optional varItem As Variant)As StringDim strErrNotes As StringIf IsMissing(varItem) Then varItem = *.*AddFilterItem = strFilter & _strDescription & vbNullChar

11、& _varItem & vbNullCharEnd FunctionPrivate Function TrimNull(ByVal strItem As String) As StringDim intPosAs IntegerDim strErrNotes As StringintPos = InStr(strItem, vbNullChar)If intPos 0 ThenTrimNull = Left(strItem, intPos - 1)ElseTrimNull = strItemEnd IfEnd FunctionPublic Function IsFileName(strFil

12、ename As String) As BooleanDim myFileSysSet myFileSys = CreateObject(Scripting.FileSystemObject)If IsNull(strFilename) ThenIsFileName = FalseElseIf myFileSys.FileExists(strFilename) ThenIsFileName = TrueElseIsFileName = FalseEnd IfEnd IfEnd FunctionPublic Function GetFileSize(strFilename As String)

13、As LongDim myFileSysSet myFileSys = CreateObject(Scripting.FileSystemObject)If IsNull(strFilename) Or Not IsFileName(strFilename) ThenGetFileSize = 0ElseGetFileSize = myFileSys.GetFile(strFilename).SizeEnd IfEnd FunctionPublic Function IsPathName(strPathName As String) As BooleanDim myFileSysSet myF

14、ileSys = CreateObject(Scripting.FileSystemObject)If IsNull(strPathName) ThenIsPathName = FalseElseIf myFileSys.FolderExists(strPathName) ThenIsPathName = TrueElseIsPathName = FalseEnd IfEnd IfEnd FunctionPublic Function CheckPathFull(ByVal strPath As String) As StringCheckPathFull = strPathIf Right(

15、strPath, 1) Then CheckPathFull = strPath & End Function以上代码输入完后保存该模块，随便起个名称就可以了。三、 设计窗体： 设计一个窗体来实现用户调用备份功能。窗体的具体样式可以按你自己喜欢的来制作， 只要包含以下几个控件： 两个文本框、两个命令按钮， 名称如下图所示：说明：1、txtSourceDir : 说明备份的文件名称，主要是显示给用户看，没有具体的作用，也可以省去！2、 txtDestionationDir :选择要备份的目标文件夹，既备份文件储存的位置。3、 CmdopenDestionationDir: 命令按钮，用户单击后可

16、以弹出窗口让用户选择备份目录，用户选择后的目录路径将显示在txtDestionationDir文本框中。4、 CmdBackup : 开始备份按钮，用户单击后将测试用户操作是否正确，正确将开始备份数据并显示备份成功，如果错误将显示错误信息。四、 为窗体添加代码： 在窗体设计界面单击代码按钮，并将以下代码拷贝进去。如下图：Option Compare DatabaseOption ExplicitPrivate Const BIF_RETURNONL YFSDIRS = 1Private Const BIF_DONTGOBELOWDOMAIN = 2Private Const MAX_PA TH

17、 = 260Private Type BROWSEINFOhwndOwnerAs LongpidlRootAs LongpszDisplayName As LonglpszTitleAs LongulFlagsAs LonglpfnCallbackAs LonglParamAs LongiImageAs LongEnd TypePrivate Declare Function SHBrowseForFolder Lib shell32 (lpbi As BROWSEINFO) As LongPrivate Declare Function SHGetPathFromIDList Lib she

18、ll32 (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, strDestinationDir As StringDim i As IntegerDim img(9) As ImagePublic Function OpenDirectoryTV(Opt

19、ional odtvTitle As String) As StringDim lpIDList As LongDim sBuffer As StringDim szTitle As StringDim tBrowseInfo As BROWSEINFOszTitle = odtvTitlelpIDList = SHBrowseForFolder(tBrowseInfo)If (lpIDList) ThensBuffer = Space(MAX_PATH)SHGetPathFromIDList lpIDList, sBuffersBuffer = Left(sBuffer, InStr(sBu

20、ffer, vbNullChar) - 1)OpenDirectoryTV = sBufferEnd IfEnd FunctionPrivate Sub Form_Load()Me.txtSourceDir = CurrentProject.Path & & PoseSky_be.mdbEnd SubPrivate Sub cmdOpenDestinationDir_Click()Me.txtDestinationDir = OpenDirectoryTV()End SubPrivate Sub cmdBackup_Click()On Error GoTo Err_ccc可以修改以下文件的名称

21、及目录为你后台数据表的位置即可If Not IsNull(Me.txtSourceDir) Then strSourceDir = Me.txtSourceDirIf Not IsNull(Me.txtDestinationDir) Then strDestinationDir = Me.txtDestinationDirIf Len(strSourceDir) 0 And Len(strDestinationDir) 0 ThenIf Me.txtDestinationDir Like * & A: & * Or Me.txtDestinationDir Like * & a:& * The

22、nFileCopy CurrentProject.Path & & PoseSky_be.mdb, _Me.txtDestinationDir & & 数据备份 .mdbDoCmd.Close acForm, 数据备份MsgBox 数据已成功备份！请取出软盘 , vbInformation + vbOKOnly, 备份完成！ElseFileCopy CurrentProject.Path & & PoseSky_be.mdb, _Me.txtDestinationDir&.mdbDoCmd.Close acForm, 数据备份 MsgBox 数据已成功备份！, vbInformation +

23、vbOKOnly, 备份完成！ AddhowDolog 数据备份 DoCmd.CloseEnd IfElseMsgBox 目标文件路径不能为空！, vbExclamation + vbOKOnly, 警告 End IfExit_ccc:Exit SubErr_ccc:If err.Number = 70 ThenMsgBox 错误号： & err.Number & 。发生错误的原因可能是： & Chr(10) &Chr(10)& 1. 数据窗口未关闭； &Chr(10)&2. 磁盘写保护。, vbExclamation+vbOKOnly, 提示 ElseMsgBox 错误号： & err.Nu

24、mber & 。发生错误的原因是： & err.Description, vbExclamation + vbOKOnly, 提示 End IfResume Exit_cccEnd SubPrivate Sub Form_Open(Cancel As Integer)End Sub注意要将以上代码中的红色部分改为你数据表的名称。代码输入完毕后在VBA窗口中单击调试菜单中的编译命令，如果有出错将在窗口中显示。如下图：五、保存测试： 以上工作完成后一个备份功能的窗体就完成了， 你可以测试一下看是否能够完成备份的功能。六、还原功能：还原窗体的制作与备份功能的步骤差不多，给窗体名称及代码如下：Private Sub 开始还原 _Click()On Error GoTo Err_csqIf Me. 还原文件= Or IsNull(Me.MsgBox 您没有选择还原文件！还原文件 ) Then, vbExclamation + vbOKOnly, 提示 Me. 还原文件.SetFocusElseIf MsgBox( 还原将覆盖原数据且不能恢复， & Chr(10) & 请确认所选的文件是否正确。&