前臺(tái)中備份后臺(tái)數(shù)據(jù)庫(kù)例子

咱家是貓

我是把它們放在"我的文檔"文件夾的

1. Option Compare Database
   
2. 
   
3. Function SysSet(SetName As String)
   
4. '提取系統(tǒng)設(shè)置的函數(shù)
   
5. 
   
6. On Error GoTo Err_SysSet
   
7. 
   
8. SysSet = DLookup("[" & SetName & "]", "備份設(shè)置")
   
9. 
   
10. Exit_SysSet:
    
11. Exit Function
    
12. 
    
13. Err_SysSet:
    
14. 
    
15. MsgBox Err.Description
    
16. Resume Exit_SysSet
    
17. 
    
18. End Function
    
19. 
    
20. Sub DefaultBackUp()
    
21. 
    
22. Dim WinRARPath As String
    
23. Dim BackFile As String
    
24. Dim BackPath As String
    
25. Dim BackUpFile As String
    
26. Dim StrCMD As String
    
27. 
    
28. If Not IsNull(SysSet("WinRAR路徑")) Then
    
29. WinRARPath = SysSet("WinRAR路徑")
    
30. Else
    
31. Do
    
32. WinRARPath = ShowFolderDlg("確認(rèn) WinRAR 程序安裝的文件夾。")
    
33. 
    
34. If WinRARPath = "" Then
    
35. MsgBox "備份任務(wù)取消！" & Chr(13) & Chr(10) & Chr(10) & "未確認(rèn) WinRAR.exe 程序的安裝路徑，系統(tǒng)需要此程序來完成備份任務(wù)。", vbInformation, "North Star"
    
36. Exit Sub
    
37. End If
    
38. If Dir(WinRARPath + "\WinRAR.exe") = "" Then
    
39. MsgBox "指定文件夾中未找到 WinRAR.exe 程序！" & Chr(13) & Chr(10) & Chr(10) & "請(qǐng)重新選擇。", vbExclamation, "North Star"
    
40. End If
    
41. Loop While Dir(WinRARPath + "\WinRAR.exe") = ""
    
42. End If
    
43. If Not IsNull(SysSet("備份路徑")) Then
    
44. BackUpPath = SysSet("備份路徑")
    
45. Else
    
46. BackUpPath = ShowFolderDlg("選擇一個(gè)存放備份數(shù)據(jù)文件的文件夾。" & Chr(13) & Chr(10) & Chr(13) & "請(qǐng)?jiān)O(shè)置為不同與后臺(tái)數(shù)據(jù)路徑的另一驅(qū)動(dòng)器路徑。")
    
47. If BackUpPath = "" Then
    
48. MsgBox "備份任務(wù)取消！" & Chr(13) & Chr(10) & Chr(10) & "您未指定存放備份數(shù)據(jù)文件的文件夾。", vbInformation, "North Star"
    
49. Exit Sub
    
50. End If
    
51. End If
    
52. BackFile = DLookup("[Database]", "MSysObjects", "Database<>Null")
    
53. BackUpFile = BackUpPath & "\BK" & Format(Date, "yyyymmdd")
    
54. StrCMD = """" & WinRARPath & "\WinRAR.exe"" a -ep -p123456 """ & BackUpFile & """ """ & BackFile & """"
    
55. 
    
56. '壓縮備份后臺(tái)數(shù)據(jù)庫(kù)
    
57. Shell StrCMD, vbNormalFocus
    
58. 
    
59. End Sub
    
60. 
    
61. Function ShowFolderDlg(strDialogTitle As String) As String
    
62. '函數(shù)作用:使用SHELL對(duì)象顯示瀏覽文件夾對(duì)話框,返回文件夾路徑,這是目前最簡(jiǎn)單的方式,不需要API函數(shù).
    
63. '函數(shù)參考:代碼來自O(shè)FFICE精英俱樂部
    
64. '函數(shù)范例:me.text1=ShowFolderDlg("請(qǐng)選擇一個(gè)數(shù)據(jù)庫(kù)文件......")
    
65. '測(cè)試狀態(tài):OK
    
66. 
    
67. Dim shApp As Object, Path1 As Object
    
68. Set shApp = CreateObject("Shell.application")
    
69. Set Path1 = shApp.BrowseForFolder(0, strDialogTitle, 0, 17)
    
70. If Path1 Is Nothing Then Exit Function
    
71. ShowFolderDlg = IIf(IsError(Path1.items.Item.Path), Path1.Title, Path1.items.Item.Path)
    
72. 
    
73. End Function
    

復(fù)制代碼

nienie2010

多謝分享

wuheng

謝謝分享，下了學(xué)習(xí)~~~~~~~~

wuheng

謝謝分享，下了學(xué)習(xí)~~~~~~~~

82077802

謝謝分享，下了學(xué)習(xí)~~~~~~~~

stwuyiyu

謝謝啊，學(xué)習(xí)了

asklove

收藏，備用，謝謝！

ZenJing

謝謝，下了學(xué)習(xí)

daviee

弱弱地問一句，在那修改要備份的數(shù)據(jù)庫(kù)路徑，我的數(shù)據(jù)不是存放在“我的文檔”中。謝謝！

daviee

樓主，用你的這個(gè)程序運(yùn)行正常，導(dǎo)入到我的程序中運(yùn)行，出現(xiàn) “此窗體或報(bào)表上指定的記錄源 RegisterInfo 不存在”，在你程序里怎么也沒找到你的這個(gè)RegisterInfo源呀？！