 | Moderator | | Join Date: Dec 2006 Location: Bangalore ,India
Posts: 7,504
# 1
Mar 17 '08
| |
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.
Last edited by debasisdas; Mar 25 '08 at 09:35 AM.
Reason: I will add inline comments to the above code later on.
|
