01-01-16, 03:13 AM
الاخوة الاعزاء اسعد الله اوقاتكم احتاج مساعدة في نسخ واسترجاع قاعدة البيانات وقد وضعت لكم هذا المشروع للتعديل علية واتمنى ان يستفيد من اكوادة من اراد الفائدة ودمتم بود
' "Fixed" '=====================================================================================
Dim Je As New JRO.JetEngine
If Rs.State = 1 Then Rs.Close
If CN.State = 1 Then CN.Close
If Dir(App.Path & "\Backup", vbDirectory) = "" Then: MkDir App.Path & "\Backup"
Je.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=medo0;Data Source= " & App.Path & "\Data.mdb" _
, "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=medo0;Data Source= " & App.Path & "\Backup\Data.mdb"
Kill App.Path & "\Data.mdb"
Name App.Path & "\Backup\Data.mdb" As App.Path & "\Data.mdb"
' "Backup" '=====================================================================================
On Error Resume Next
Dim y As Variant
y = Format(Now, "yyyy-MM-dd hh-mm A/P")
If Dir(App.Path & "\Data.mdb") = "" Then
MsgBox "The database does not exist in the program path", vbCritical, "Attention"
Exit Sub
End If
If Rs.State = 1 Then Rs.Close
If CN.State = 1 Then CN.Close
If Dir(App.Path & "\Backup", vbDirectory) = "" Then
MkDir App.Path & "\Backup"
End If
If Dir("E:\Backup", vbDirectory) = "" Then
MkDir "E:\Backup"
End If
FileCopy App.Path & "\Data.mdb", App.Path & "\Backup\" & y & ".mdb"
If MsgBox("the backup was saved in specified path . do you want saved in elsewhere?", vbInformation + vbYesNo, "Backup") = vbYes Then
'====================
With CommonDialog1
.CancelError = True
.DialogTitle = "Save Backup"
.Filter = "Access Database (*.mdb)|*.mdb"
.FilterIndex = 1
.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
.FileName = y & ".mdb"
.ShowSave
End With
FileCopy App.Path & "\Data.mdb", CommonDialog1.FileName
MsgBox "Were backed up in the specified path", vbInformation, "Backup"
End If
On Error Resume Next
' "Restore" '=====================================================================================
On Error Resume Next
If Rs.State = 1 Then Rs.Close
If CN.State = 1 Then CN.Close
With CommonDialog1
.CancelError = True
.DialogTitle = "Choose the database file"
.Filter = "Access Database (*.mdb)|*.mdb"
.FilterIndex = 1
.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
.FileName = ""
.ShowOpen
End With
If CommonDialog1.FileName = "" Then Exit Sub
Kill App.Path & "\Data.mdb"
FileCopy CommonDialog1.FileName, App.Path & "\Data.mdb"
MsgBox "It has been successfully connect the new database", vbInformation, "Connected"