Kevin-
If you are using my relink code, then you can do this on exit to do a backup. Note that this code must run in an unbound (no record source) form that has no combo box or list box controls. Most of my applications have a "frmMain" that is an unbound "switchboard" form for the user to get to the various parts of the app. The Exit code looks like this:
Public Sub cmdExit_Click()
Dim intErr As Integer, frm As Form, intI As Integer, strData As String, strDir As String
Dim lngOpen As Long, datBackup As Date
Dim strLowBkp As String, strBkp As String, intBkp As Integer
Dim db As DAO.Database, rst As DAO.Recordset
If vbNo = MsgBox("Are you sure you want to exit?", vbYesNo + vbQuestion + vbDefaultButton2, _
gstrAppTitle) Then
Exit Sub
End If
' Trap any errors
On Error Resume Next
' Make sure all forms are closed
For intI = (Forms.Count - 1) To 0 Step -1
Set frm = Forms(intI)
' Don't close myself!
If frm.Name <> "frmMain" Then
' Close the form
DoCmd.Close acForm, frm.Name
DoEvents
End If
' Note any error that occured
If Err <> 0 Then intErr = -1
Next intI
' Log any error beyond here
On Error GoTo frmMain_Error
' Skip backup check if there were errors
If intErr = 0 Then
Set db = DBEngine(0)(0)
' Open ztblVersion to see if we need to do a backup
Set rst = db.OpenRecordset("ztblVersion", dbOpenDynaset)
rst.MoveFirst
lngOpen = rst!OpenCount
datBackup = rst!LastBackup
rst.Close
Set rst = Nothing
' If the user has opened 10 times or last backup was more than 2 weeks ago...
If (lngOpen Mod 10 = 0) Or ((Date - datBackup) > 14) Then
' Ask if they want to backup...
If vbYes = MsgBox("Management highly recommends backing up your data to avoid " & _
"any accidental data loss. Would you like to backup now?", _
vbYesNo + vbQuestion, gstrAppTitle) Then
' Get the name of the data file
strData = Mid(db.TableDefs("ztblVersion").Connect, 11)
' Get the name of its folder
strDir = Left(strData, InStrRev(strData, "\"))
' See if the "BackupData" folder exists
If Len(Dir(strDir & "BackupData", vbDirectory)) = 0 Then
' Nope, build it!
MkDir strDir & "BackupData"
End If
' Now find any existing backups - keep only three
strBkp = Dir(strDir & "BackupData\MembershipBkp*.mdb") ' << Fix this name
Do While Len(strBkp) > 0
intBkp = intBkp + 1
If (strBkp < strLowBkp) Or (Len(strLowBkp) = 0) Then strLowBkp = strBkp
strBkp = Dir
Loop
If intBkp > 2 Then
Kill strDir & "BackupData\" & strLowBkp
End If
' Now, setup new backup name based on today's date
' **** FIX NAME OF FILE IN LINE BELOW ****
strBkp = strDir & "BackupData\MembershipBkp" & Format(Date, "yymmdd") & ".mdb"
' Make sure the target file doesn't exist
If Len(Dir(strBkp)) > 0 Then Kill strBkp
' Create the backup file using Compact
DBEngine.CompactDatabase strData, strBkp
' Now update the backup date
db.Execute "UPDATE ztblVersion SET LastBackup = #" & Date & "#", dbFailOnError
MsgBox "Backup created successfully!", vbInformation, gstrAppTitle
End If
' See if error log has 20 or more entries
If db.TableDefs("ErrorLog").RecordCount > 20 Then
' Don't ask if they've said not to...
If Not (DLookup("DontSendError", "ztblVersion")) Then
DoCmd.OpenForm "fdlgErrorSend", WindowMode:=acDialog
Else
db.Execute "DELETE * FROM ErrorLog", dbFailOnError
End If
End If
End If
Set db = Nothing
End If
' We're outta here!
frmMain_Exit:
On Error GoTo 0
DoCmd.Close acForm, Me.Name
Application.Quit acSaveNone
Exit Sub
frmMain_Error:
ErrorLog "frmMain", Err, Error
Resume frmMain_Exit
End Sub
The first thing the code does is close all forms except "frmMain" where this code is running. If you're using my relink code, then you built a ztblVersion in the back end database. Every 10 times the app is opened (count is kept in ztblVersion), it offers to create a backup on close, and it keeps up to three copies in a subfolder called BackupData.
John Viescas, Author
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
SQL Queries for Mere Mortals
(Paris, France)
On Dec 17, 2015, at 1:16 AM, zhaoliqingoffice zhaoliqingoffice@163.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
Dear All,
Is there free backup tools out there for backing up backends. Thanks.
Best Regards,
Kevin
__._,_.___
Posted by: John Viescas <johnv@msn.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (2) |
.
__,_._,___
Tidak ada komentar:
Posting Komentar