Backup / Restore of Access Database

[debasisdas]

This is a sample code for taking backup and restore of access database

Dim DBTempSource As Database
Dim DBTempDestination As Database
 
Dim RecTempSource As Recordset
Dim RecTempDestination As Recordset
 
Sub MBackup()
 
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Errors
If OptBackup Then
    TxtRemarks = "Backup Started at " & Time
    TxtRemarks = TxtRemarks & vbCrLf & "Closing Connection ...!"
    GCnnGeneral.Close
    TxtRemarks = TxtRemarks & vbCrLf & "Checking Destination ...!"
    If GFileExists(TxtDestination) Then
        Kill TxtDestination
    End If
 
    TxtRemarks = TxtRemarks & vbCrLf & "Compacting Source ..."
    DBEngine.CompactDatabase TxtSource, TxtDestination, , , ";pwd=Debasis"
    TxtRemarks = TxtRemarks & vbCrLf & "Destination Created ...!"
    TxtRemarks = TxtRemarks & vbCrLf & "Connecting Database ...!"
    With GCnnGeneral
       .Provider = "Microsoft.Jet.OLEDB.4.0"
       .Properties("Jet OLEDB:Database Password") = "Debasis"
       .Mode = adModeReadWrite
       .Open App.Path & "\" & Trim(GFileName) & ".MDB"
    End With
    'GFileName = Trim(LstDatabase.Text)
    TxtRemarks = TxtRemarks & vbCrLf & "Backup Created at " & Time
    MsgBox "Backup Created."
    TxtSource = GEmptyStr
    TxtDestination = GEmptyStr
ElseIf OptRestore Then
    'GCnnAccts.Close
    TxtRemarks = "Restoring Data Started at " & Time
    GCnnGeneral.Close
    TxtRemarks = TxtRemarks & vbCrLf & "Connection Closed ...!"
    Kill TxtDestination
    TxtRemarks = TxtRemarks & vbCrLf & "Destination Checked ...!"
    Call FSO.CopyFile(TxtSource, TxtDestination, True)
    TxtRemarks = TxtRemarks & vbCrLf & "Data Restored ...!"
    With GCnnGeneral
       .Provider = "Microsoft.Jet.OLEDB.4.0"
       .Properties("Jet OLEDB:Database Password") = "Debasis"
       .Mode = adModeReadWrite
       .Open App.Path & "\" & Trim(GFileName) & ".MDB"
    End With
    TxtRemarks = TxtRemarks & vbCrLf & "Connection Complete ...!"
    TxtRemarks = TxtRemarks & vbCrLf & "Data Restored at " & Time
    MsgBox "Data Restored."
End If
 
Exit Sub
Errors:
    MsgBox "[ErrNo.: " & Err.Number & "] " & Err.Description
End Sub
 
Private Sub CmdBackup_Click()
If Trim(TxtSource) = GEmptyStr Then
    MsgBox "Source Filename Empty."
    Exit Sub
End If
 
If Trim(TxtDestination) = GEmptyStr Then
    MsgBox "Destination Filename Empty."
    Exit Sub
End If
 
If OptBackup Then
    If Not GFileExists(TxtSource) Then
        MsgBox "Source File Does Not Exist! Please Contact Program Vendor."
        Exit Sub
    End If
    If GFileExists(TxtDestination) Then
        If MsgBox("Destination File Already Exists! Do you Want to Replace the File?", vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        End If
    End If
ElseIf OptRestore Then
    If Not GFileExists(TxtSource) Then
        MsgBox "Source File Does Not Exist! Check Filename and Path."
        Exit Sub
    End If
End If
Call MBackup
End Sub
 
Private Sub CmdDestinationSearch_Click()
If OptBackup Then
    CDOpen.DefaultExt = "Bak"
    CDOpen.FileName = "Temp.Bak"
    CDOpen.ShowSave
    TxtDestination = CDOpen.FileName
Else
    TxtDestination = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")  'GFileName
End If
End Sub
 
Private Sub CmdExit_Click()
Unload Me
End Sub
 
Private Sub CmdSourceSearch_Click()
If OptBackup Then
    TxtSource = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")    'GFileName
Else
    CDOpen.DefaultExt = "Bak"
    CDOpen.FileName = "Temp.Bak"
    CDOpen.ShowOpen
    TxtSource = CDOpen.FileName
End If
End Sub
 
Private Sub Form_Resize()
Me.Left = (FrmBackground.Width - Me.Width) / 2
Me.Top = (FrmBackground.Height - Me.Height) / 2
End Sub
 
Private Sub OptAll_Click()
FraPart.Visible = False
End Sub
 
Private Sub OptBackup_Click()
CmdBackup.Caption = OptBackup.Caption & " &File"
TxtRemarks = GEmptyStr
End Sub
 
Private Sub OptPart_Click()
FraPart.Visible = True
DtpFrom = Format(DateAdd("d", 7, GTransactDate), "dd/MMM/yyyy")
DtpTo = Format(GTransactDate, "dd/MMM/yyyy")
End Sub
 
Private Sub OptRestore_Click()
CmdBackup.Caption = OptRestore.Caption & " &File"
TxtRemarks = GEmptyStr
End Sub
 

NOTE:--Users can customize the above code by adding / altering / removing the name of the controls and other parts of the code.

[make me rain]

Thanks for replay.
but this code not explaining the main objective of closing the data base
dim dbs of database
set dbs = "c:\dbsmdb"
like dbs.close
that means i trying to close an instance of MS access opened at address at "c:\dbsmdb"
please advise