424,279 Members | 1,907 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

Backup / Restore of Access Database

debasisdas
Expert 5K+
P: 8,127
This is a sample code for taking backup and restore of access database

Expand|Select|Wrap|Line Numbers
  1. Dim DBTempSource As Database
  2. Dim DBTempDestination As Database
  3.  
  4. Dim RecTempSource As Recordset
  5. Dim RecTempDestination As Recordset
  6.  
  7. Sub MBackup()
  8.  
  9. Set FSO = CreateObject("Scripting.FileSystemObject")
  10. On Error GoTo Errors
  11. If OptBackup Then
  12.     TxtRemarks = "Backup Started at " & Time
  13.     TxtRemarks = TxtRemarks & vbCrLf & "Closing Connection ...!"
  14.     GCnnGeneral.Close
  15.     TxtRemarks = TxtRemarks & vbCrLf & "Checking Destination ...!"
  16.     If GFileExists(TxtDestination) Then
  17.         Kill TxtDestination
  18.     End If
  19.  
  20.     TxtRemarks = TxtRemarks & vbCrLf & "Compacting Source ..."
  21.     DBEngine.CompactDatabase TxtSource, TxtDestination, , , ";pwd=Debasis"
  22.     TxtRemarks = TxtRemarks & vbCrLf & "Destination Created ...!"
  23.     TxtRemarks = TxtRemarks & vbCrLf & "Connecting Database ...!"
  24.     With GCnnGeneral
  25.        .Provider = "Microsoft.Jet.OLEDB.4.0"
  26.        .Properties("Jet OLEDB:Database Password") = "Debasis"
  27.        .Mode = adModeReadWrite
  28.        .Open App.Path & "\" & Trim(GFileName) & ".MDB"
  29.     End With
  30.     'GFileName = Trim(LstDatabase.Text)
  31.     TxtRemarks = TxtRemarks & vbCrLf & "Backup Created at " & Time
  32.     MsgBox "Backup Created."
  33.     TxtSource = GEmptyStr
  34.     TxtDestination = GEmptyStr
  35. ElseIf OptRestore Then
  36.     'GCnnAccts.Close
  37.     TxtRemarks = "Restoring Data Started at " & Time
  38.     GCnnGeneral.Close
  39.     TxtRemarks = TxtRemarks & vbCrLf & "Connection Closed ...!"
  40.     Kill TxtDestination
  41.     TxtRemarks = TxtRemarks & vbCrLf & "Destination Checked ...!"
  42.     Call FSO.CopyFile(TxtSource, TxtDestination, True)
  43.     TxtRemarks = TxtRemarks & vbCrLf & "Data Restored ...!"
  44.     With GCnnGeneral
  45.        .Provider = "Microsoft.Jet.OLEDB.4.0"
  46.        .Properties("Jet OLEDB:Database Password") = "Debasis"
  47.        .Mode = adModeReadWrite
  48.        .Open App.Path & "\" & Trim(GFileName) & ".MDB"
  49.     End With
  50.     TxtRemarks = TxtRemarks & vbCrLf & "Connection Complete ...!"
  51.     TxtRemarks = TxtRemarks & vbCrLf & "Data Restored at " & Time
  52.     MsgBox "Data Restored."
  53. End If
  54.  
  55. Exit Sub
  56. Errors:
  57.     MsgBox "[ErrNo.: " & Err.Number & "] " & Err.Description
  58. End Sub
  59.  
  60. Private Sub CmdBackup_Click()
  61. If Trim(TxtSource) = GEmptyStr Then
  62.     MsgBox "Source Filename Empty."
  63.     Exit Sub
  64. End If
  65.  
  66. If Trim(TxtDestination) = GEmptyStr Then
  67.     MsgBox "Destination Filename Empty."
  68.     Exit Sub
  69. End If
  70.  
  71. If OptBackup Then
  72.     If Not GFileExists(TxtSource) Then
  73.         MsgBox "Source File Does Not Exist! Please Contact Program Vendor."
  74.         Exit Sub
  75.     End If
  76.     If GFileExists(TxtDestination) Then
  77.         If MsgBox("Destination File Already Exists! Do you Want to Replace the File?", vbYesNo + vbQuestion) = vbNo Then
  78.             Exit Sub
  79.         End If
  80.     End If
  81. ElseIf OptRestore Then
  82.     If Not GFileExists(TxtSource) Then
  83.         MsgBox "Source File Does Not Exist! Check Filename and Path."
  84.         Exit Sub
  85.     End If
  86. End If
  87. Call MBackup
  88. End Sub
  89.  
  90. Private Sub CmdDestinationSearch_Click()
  91. If OptBackup Then
  92.     CDOpen.DefaultExt = "Bak"
  93.     CDOpen.FileName = "Temp.Bak"
  94.     CDOpen.ShowSave
  95.     TxtDestination = CDOpen.FileName
  96. Else
  97.     TxtDestination = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")  'GFileName
  98. End If
  99. End Sub
  100.  
  101. Private Sub CmdExit_Click()
  102. Unload Me
  103. End Sub
  104.  
  105. Private Sub CmdSourceSearch_Click()
  106. If OptBackup Then
  107.     TxtSource = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")    'GFileName
  108. Else
  109.     CDOpen.DefaultExt = "Bak"
  110.     CDOpen.FileName = "Temp.Bak"
  111.     CDOpen.ShowOpen
  112.     TxtSource = CDOpen.FileName
  113. End If
  114. End Sub
  115.  
  116. Private Sub Form_Resize()
  117. Me.Left = (FrmBackground.Width - Me.Width) / 2
  118. Me.Top = (FrmBackground.Height - Me.Height) / 2
  119. End Sub
  120.  
  121. Private Sub OptAll_Click()
  122. FraPart.Visible = False
  123. End Sub
  124.  
  125. Private Sub OptBackup_Click()
  126. CmdBackup.Caption = OptBackup.Caption & " &File"
  127. TxtRemarks = GEmptyStr
  128. End Sub
  129.  
  130. Private Sub OptPart_Click()
  131. FraPart.Visible = True
  132. DtpFrom = Format(DateAdd("d", 7, GTransactDate), "dd/MMM/yyyy")
  133. DtpTo = Format(GTransactDate, "dd/MMM/yyyy")
  134. End Sub
  135.  
  136. Private Sub OptRestore_Click()
  137. CmdBackup.Caption = OptRestore.Caption & " &File"
  138. TxtRemarks = GEmptyStr
  139. End Sub
  140.  
NOTE:--Users can customize the above code by adding / altering / removing the name of the controls and other parts of the code.
Mar 17 '08 #1
Share this Article
Share on Google+
1 Comment


P: 3
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
Nov 5 '08 #2