How to backup Access file using VBA code and zip it

Hi, it's been a lot of time since last post.
i have found this nice access file that is very useful if you have an access database file that is separated from the original main file, it's mean like this scenario:

you have the main program that is an access file (*.mdb or *.mde) (like main.mde) that contains all the forms and the reports and the modules.. and you have a separate file mdb or mde also (like data.mdb) that contains the tables and the data..
in this way you can't make a backup of the data file using backup database tool located in the access software... you need to backup the data.mdb file...

so how you do this!!!

using the modules located in this file "backup demo" you can easily do this..
just click the button and the program will check if you have installed Winzip... if you did it will backup the file to a temporary folder and zip it than save it in the location you want..
else
it will just copy the file to the location you give it.
end surely it will set the name of the file backup_DATE_TIME.. where date is the current date and the time is the current time..

if you need to change anything you can go deeply in the code..

here is the file links:
http://www.ziddu.com/download/3537240/BackUpDemo.zip.html


here you can view the code of the ZipandBackUpDb

Function ZipandBackUpDb()
On Error GoTo Err_BackUpDb

'this line is very important to handle files
'it's very necessary to add the "Microsoft scripting runtime" reference from the tools->references in the VBA window
Dim fso As FileSystemObject

Dim sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
Dim strFileName As String
Dim sBackupFolder As String
Dim sFinalPath As String

'this will show you the dialog box to select the file you want to backup
strFileName = FindBackUpFile
If Not strFileName = "None Selected" Then
sSourcePath = strFileName
Else
MsgBox " BackUp Action cancelled. Database not backed up. ", vbCritical, " BackUp Failure"
Exit Function
End If

'this will create a temporary directory on "C:\" and will call it Temp if there is no a temp directory
If Not Dir("C:\Temp", vbDirectory) <> "" Then MkDir "C:\Temp"
sBackupPath = "C:\Temp\"
sBackupFile = "BackUp.mdb"

'this will show you the dialog box to select where you want to save the zipped file
sBackupFolder = FindBackUpFolder
If Not sBackupFolder = "None Selected" Then
sFinalPath = sBackupFolder & "\"
Else
MsgBox " BackUp Action cancelled. Database not backed up. ", vbCritical, " BackUp Failure"
Exit Function
End If

'this will make the cursor hour glass shape
Screen.MousePointer = 11

Set fso = New FileSystemObject
fso.CopyFile sSourcePath, sBackupPath & sBackupFile, True
Set fso = Nothing

Dim sWinZip As String
Dim sZipFile As String
Dim sZipFileName As String
Dim sFileToZip As String


sWinZip = "C:\Program Files\WinZip\WinZip32.exe" 'Location of the WinZip program

'here you can change the name of the file.
sZipFileName = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & Format(Date, "dd-mm-yyyy") & "-" & Format(Time, "hh-mmAMPM") & ".zip"
sZipFile = sBackupPath & sZipFileName
sFileToZip = sBackupPath & sBackupFile

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)

Pause (3)

Set fso = New FileSystemObject
fso.CopyFile sBackupPath & sZipFileName, sFinalPath & sZipFileName, True
Set fso = Nothing


Screen.MousePointer = 0

MsgBox "Backup was successful. " & "The backup file is named: " & Chr(13) & " " & sFinalPath & sZipFileName, vbInformation, "Backup Completed"

If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
If Dir(sBackupPath & sZipFileName) <> "" Then Kill (sBackupPath & sZipFileName)

Exit_BackUpDb:
Exit Function

Err_BackUpDb:
If Err = 5 Then 'Invalid procedure call or argument
MsgBox "Disk is full! Can not move the zip file to the Drive. Please move the " & sZipFile & " file to a safe location.", vbCritical, " BackUp Failure"
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
If Dir(sBackupPath & sZipFileName) <> "" Then Kill (sBackupPath & sZipFileName)
Exit Function
ElseIf Err = 53 Then 'File not found
MsgBox "Source file can not be found!" & vbNewLine & sZipFileName, vbCritical, " BackUp Failure"
Exit Function
ElseIf Err = 71 Then 'Disk not ready
If Dir(sZipFile) <> "" Then Kill sZipFile
If Dir(sFileToZip) <> "" Then Kill sFileToZip
MsgBox "Please insert a diskette in Drive and try again!", vbCritical, " BackUp Failure"
Exit Function
ElseIf Err = -2147024784 Then 'Method 'CopyFile' of object 'IFileSystem3' failed
MsgBox "File is to large to be zipped to the Drive!" & vbNewLine & sZipFile, vbCritical, " BackUp Failure"
Exit Function
Else
MsgBox Err.Number & " - " & Err.Description, , " BackUp Failure"
Resume Exit_BackUpDb
End If

End Function