Expand|Select|Wrap|Line Numbers
- 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