مطلوب حفظ جداول قاعدة بيانات في مسار محدد مسبقا

[iibat]

المطلوب : حدث عند النقر.

·         حفظ نسخة  من جداول  أي قاعدة بيانات يتم تحديد مسار موقعها .

·         ونسخها الي مجلد محدد مسبقا . D:\Save

 ·         على ان يكون اسم مجلد جداول قاعدة البيانات المنسوخة مكون من التالي XXX 2021-09-14 

 ·         ( ايضاح )  التاريخ يكون هو تاريخ اليوم الذي تم عمل نسخة فيه الي المجلد D:\Save.

 ·         (( XXX  المكون من 3 حروف يستخدم كرمز يميزها  عن اسم قاعدة البيانات اخرى .

 

او أي طريقة اخرى ترونها مناسبة تفي بالغرض يتم من خلالها  تمييز جداول قاعدة بيانات عن الاخرى .

تم تعديل سبتمبر 14, 2021 بواسطه iibat

[د.كاف يار]

تفضل ضع هذا الكود في ازرار انشاء نسخة احتياطية

On Error GoTo ErrH
Dim fso As Object
Dim fldrname As String
Dim fldrpath As String
Set fso = CreateObject("scripting.filesystemobject")
          fldrpath = CurrentProject.Path & "\Backup"
          If Not fso.FolderExists(fldrpath) Then
             fso.createfolder (fldrpath)
             DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);"

          End If

Dim MyFile, DstFile As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss") & ".accdb"

DBEngine.Idle

Set Syso = CreateObject("Scripting.FileSystemObject")
Syso.copyfile MyFile, DstFile
Set Syso = Nothing

Name DstFile As DstFile & ".ptc"
DBEngine.CompactDatabase DstFile & ".ptc", DstFile
Kill DstFile & ".ptc"
Dim db As DAO.Database
Dim MaxBackup_NO As Integer
MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1
    Dim rs As DAO.Recordset
    Set db = CurrentDb
Set rs = db.OpenRecordset("Backup")
    With rs
        .AddNew
        ![Backup_NO] = MaxBackup_NO
        ![Backup_Name] = Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss")
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing


MsgBox "تم انشاء قاعدة البيانات بنجاح" & vbNewLine & "Database successfully created" & vbNewLine & vbNewLine & "" & "اسم قاعدة البيانات" & vbNewLine & "The name of the database" & vbNewLine & "" & vbNewLine & "Backup-" & Format(Date, "dd-mm-yyyy") & vbNewLine & vbNewLine & "" & "مسار القاعدة الجديدة" & vbNewLine & "Path of the new rule" & vbNewLine & "" & vbNewLine & DstFile, vbMsgBoxRight + vbOKOnly, "emphasis" & "/" & "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

 

[iibat]

ايضاح حول الكود / في المرفق 

 

pakup.mdb