Public Sub Backup()
'This function backs up to the g: drive, you can back up to any location,
'just change the strDest Value
On Error GoTo Err_Backup
Dim db As Database
Dim strSource As String, strDest As String, strError As String
Dim strDate As String, strDateX As String
If MsgBox("Are you sure you want to back up data?", vbQuestion + vbYesNo, " Continue with Data Back-Up?") = vbYes Then
'Un-comment the following 3 lines for a new backup for every day
'strDate = Format(Date, "mm/dd/yy")
'strDateX = Left(strDate, 2) & Mid(strDate, 4, 2) & Right(strDate, 2)
'strDest = "a:\" & strDateX
Set db = CurrentDb()
DoCmd.Hourglass True
'Put any table name in here that exists in your back-end
strSource = db.TableDefs("trkTracker").Connect
strSource = Mid(strSource, 11, Len(strSource) - 10)
'If you are using a new back-up every day, un-comment this line and replace the database name, and comment out the next line down
'strDest = strDest & "_YourBackEndDBNameHere.mdb"
'Replace with your database Back-end name
strDest = "g:\Debt Management\DMU Tracker\Back-Up
Files\Legal Tracker Data Backup.mdb"
'Copy the file
FileCopy strSource, strDest
db.Close
DoCmd.Hourglass False
MsgBox ("Backup to " & vbNewLine & strDest & vbNewLine & " is Complete")
End If
Exit_Backup:
Exit Sub
Err_Backup:
'Display appropriate Error Message
Select Case Err.Number
Case 61
strError = "Floppy disk is full" & vbNewLine & "cannot export mdb"
MsgBox strError, vbCritical, " Disk Full"
Kill strDest
Case 70
strError = "File is open" & vbNewLine & "cannot export mdb"
MsgBox strError, vbCritical, " File Open"
Case 71
strError = "No disk in drive" & vbNewLine & "please insert disk"
MsgBox strError, vbCritical, " No Disk"
Case Else
Err.Raise Err.Number, Err.Description
End Select
DoCmd.Hourglass False
Resume Exit_Backup
End Sub