كود نسخة احتياطية

**abouelhassan** · يوليو 23, 2021

السلام عليكم اخوانى الافاضل

قرأت كثير بالمنتدى ووجدت نسخ احتياطى كثيرا بس كلها اما للجداول فقط واما للقواعد المقسمة واما نسخة فى نفس المسار

احتاج مثال لتطبيقه لدى بقاعدة بيانات

بحيث احدد فيه المسار وعدد النسخ الاحتياطية وتكون نسخة طبق الاصل من القاعدة الاساسية

هل من افادة بمثال مع الشكر من القلب

**د.كاف يار** · يوليو 23, 2021

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية

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, DataName As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")"
DstFile = CurrentProject.Path & "\Backup\" & DataName & ".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] = DataName
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing




MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

تم تعديل يوليو 23, 2021 بواسطه د.كاف يار

**abouelhassan** · يوليو 23, 2021

ربنا يرضى عنك استاذى الغالى الى قلبى حبيبى د.كاف يار الفاضل

اشكرك استاذى

هذا المثال المرفق لاحد الاساتذة بالمنتدى هو ما احتاج مثله للتطبيق على قاعدة بياناتى

هو محترف جدا بس بيعمل نسخة احتساطى للقواعد المقسمة المرتبطة انا مش عارفها وجدته فى المنتدى احتاج مثله للقواعد العادية

ربنا يكرمك يارب

Backup (2).rar

**د.كاف يار** · يوليو 23, 2021

1 دقيقه مضت, abouelhassan said:

هو محترف جدا بس بيعمل نسخة احتساطى للقواعد المقسمة المرتبطة انا مش عارفها وجدته فى المنتدى احتاج مثله للقواعد العادية

جرب الكود الي اعطيتك هو لا تحاول تنفذ اشياء تصعب عليك

جرب الكود الي اعطيتك هو و بعد التجربة احكم هل يأدي المصلحة او لا

**abouelhassan** · يوليو 23, 2021

بارك الله فيك استاذى الغالى د.كاف يار

اعزك الله وزادك من فضله ورعاك اللهم امين

**محمد أبوعبدالله** · يوليو 23, 2021

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر

تفضل اخي الكريم

جرب الكود التالي

    Dim strFolderPath As String
  
    Dim DB_Full_Name As String
    Dim DB_Name As String
    Dim Backup_Full_Name As String
    Dim Copy_File As Variant
    Dim DB_Directory As String

    strFolderPath = CurrentProject.Path & "\Backup\"
    ' التاكد من وجود مجلد Backup
    ' اذ لم يكن موجود يتم انشائه
    If Len(Dir(strFolderPath, vbDirectory)) = 0 Then
       MkDir strFolderPath
    End If


    ' تحديد قاعدة البيانات
    DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name
    ' تحديد مسار قاعدة البيانات
    DB_Directory = CurrentProject.Path
        ' تحديد اسم قاعدة البيانات
    DB_Name = CurrentProject.Name
    ' تحديد مسار النسحة الاحتياطية
    Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde"

    If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then
        Set Copy_File = CreateObject("Scripting.FileSystemObject")
        Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True
    End If

تحياتي

**abouelhassan** · يوليو 23, 2021

4 ساعات مضت, محمد أبوعبدالله said:

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر

تفضل اخي الكريم

جرب الكود التالي

    Dim strFolderPath As String
  
    Dim DB_Full_Name As String
    Dim DB_Name As String
    Dim Backup_Full_Name As String
    Dim Copy_File As Variant
    Dim DB_Directory As String

    strFolderPath = CurrentProject.Path & "\Backup\"
    ' التاكد من وجود مجلد Backup
    ' اذ لم يكن موجود يتم انشائه
    If Len(Dir(strFolderPath, vbDirectory)) = 0 Then
       MkDir strFolderPath
    End If


    ' تحديد قاعدة البيانات
    DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name
    ' تحديد مسار قاعدة البيانات
    DB_Directory = CurrentProject.Path
        ' تحديد اسم قاعدة البيانات
    DB_Name = CurrentProject.Name
    ' تحديد مسار النسحة الاحتياطية
    Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde"

    If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then
        Set Copy_File = CreateObject("Scripting.FileSystemObject")
        Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True
    End If

تحياتي

بارك الله فيك اخي الكريم استاذى الحبيب ربنا يحفظك يارب ويديك الصحة والعافية ويبارك لك. اللهم امين

**عبد اللطيف سلوم** · يوليو 23, 2021

9 ساعات مضت, د.كاف يار said:

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية

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, DataName As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")"
DstFile = CurrentProject.Path & "\Backup\" & DataName & ".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] = DataName
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing




MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

تسلم دكتورنا الغالي

جربت الكود وهو شغال 100%

ويعمل على نظام 64 بت ونظام 32 بت

**د.كاف يار** · يوليو 24, 2021

15 ساعات مضت, عبد اللطيف سلوم said:

تسلم دكتورنا الغالي

جربت الكود وهو شغال 100%

ويعمل على نظام 64 بت ونظام 32 بت

الله يسلمك على رأسي والله انك استفدت

شكرا لك

**abouelhassan** · أغسطس 9, 2021

السلام عليكم استاذى د.كاف يار انا اسف لى سؤال الله يكرمك

انا واضع قاعدة البيانات على جول درايف عند الضغط على انشاء نسخة احتياطية لا يعمل الكود وعند نسخ القاعدة على اى بارتشن على الجهاز الكود يعمل نسخة احتياطية تمام

مش عارف ليه بارك الله فيك استاذى

**Eng.Qassim** · أغسطس 9, 2021

On 7/23/2021 at 4:22 AM, د.كاف يار said:

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية

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, DataName As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")"
DstFile = CurrentProject.Path & "\Backup\" & DataName & ".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] = DataName
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing




MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

شكرا @د.كاف يارلكن هل يمكن مسح القديمة؟

**Eng.Qassim** · أغسطس 9, 2021

On 7/23/2021 at 6:59 AM, محمد أبوعبدالله said:

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر

تفضل اخي الكريم

جرب الكود التالي

    Dim strFolderPath As String
  
    Dim DB_Full_Name As String
    Dim DB_Name As String
    Dim Backup_Full_Name As String
    Dim Copy_File As Variant
    Dim DB_Directory As String

    strFolderPath = CurrentProject.Path & "\Backup\"
    ' التاكد من وجود مجلد Backup
    ' اذ لم يكن موجود يتم انشائه
    If Len(Dir(strFolderPath, vbDirectory)) = 0 Then
       MkDir strFolderPath
    End If


    ' تحديد قاعدة البيانات
    DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name
    ' تحديد مسار قاعدة البيانات
    DB_Directory = CurrentProject.Path
        ' تحديد اسم قاعدة البيانات
    DB_Name = CurrentProject.Name
    ' تحديد مسار النسحة الاحتياطية
    Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde"

    If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then
        Set Copy_File = CreateObject("Scripting.FileSystemObject")
        Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True
    End If

تحياتي

شكرا استاذ محمد أبو عبدالله

لكن هناك نقص

Dim strFolderPath As String

**محمد أبوعبدالله** · أغسطس 10, 2021

3 ساعات مضت, Eng.Qassim said:

لكن هناك نقص

Dim strFolderPath As String

متأكد ؟

**Eng.Qassim** · أغسطس 10, 2021

2 hours ago, محمد أبوعبدالله said:

متأكد ؟

الظاهر انها كانت للاعلى ولم انسخها

هههههه اعتذر جدا

**د.كاف يار** · أغسطس 10, 2021

8 ساعات مضت, abouelhassan said:

السلام عليكم استاذى د.كاف يار انا اسف لى سؤال الله يكرمك

انا واضع قاعدة البيانات على جول درايف عند الضغط على انشاء نسخة احتياطية لا يعمل الكود وعند نسخ القاعدة على اى بارتشن على الجهاز الكود يعمل نسخة احتياطية تمام

مش عارف ليه بارك الله فيك استاذى

يعمل على google drive بدون مشكلة

اعطيني الكود بعد التعديل خليني القي نظرة عليه

7 ساعات مضت, Eng.Qassim said:

شكرا @د.كاف يارلكن هل يمكن مسح القديمة؟

نعم يمكن مسح القديمة من خلال Kill

**abouelhassan** · أغسطس 10, 2021

في ٢٣‏/٧‏/٢٠٢١ at 03:22, د.كاف يار said:

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية

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, DataName As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")"
DstFile = CurrentProject.Path & "\Backup\" & DataName & ".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] = DataName
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing




MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

اشكرك استاذى الحبيب

هذا الكود فى نفس القاعدة يعمل عند وضعه على بارتشن الجهاز ويخرج رسالة تم عمل النسخة ويعمل فولدر باك اب وبه نسخة تمام

عند وضعه على جوجل درايف كما هو لا يعمل

ليه مش عارف بارك الله فيك استاذى

**د.كاف يار** · أغسطس 10, 2021

5 دقائق مضت, abouelhassan said:

اشكرك استاذى الحبيب

هذا الكود فى نفس القاعدة يعمل عند وضعه على بارتشن الجهاز ويخرج رسالة تم عمل النسخة ويعمل فولدر باك اب وبه نسخة تمام

عند وضعه على جوجل درايف كما هو لا يعمل

ليه مش عارف بارك الله فيك استاذى

اقصد الكود بعد التعديل يعني بعد اضافة موقع قوقل درايف

**abouelhassan** · أغسطس 10, 2021

3 ساعات مضت, د.كاف يار said:

اقصد الكود بعد التعديل يعني بعد اضافة موقع قوقل درايف

بارك الله فيك اخي الكريم استاذى الحبيب

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

**د.كاف يار** · أغسطس 10, 2021

20 دقائق مضت, abouelhassan said:

بارك الله فيك اخي الكريم استاذى الحبيب

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

لا اعلم ما السبب للأسف فاليس لدي توقعات لكن من الافضل ان تضع البرنامج خارج مجلد جوجل درايف

و تضع داخل الكود رابط مجلد جوجل درايف و هذا هو الاجراء السليم

**محمد أبوعبدالله** · أغسطس 10, 2021

1 ساعه مضت, abouelhassan said:

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

هل جربت الكود الذي ارفقته لك

اعتقدت ان الموضوع متعلق بصلاحيات ويندوز

ولكني جربت الكود الآن فلم تظهر مشكلة والحمد لله وتم عمل نسخة احتياطية بنجاح

تحياتي

**أ / محمد صالح** · أغسطس 10, 2021

جوجل درايف بارتيشن عبارة عن مجلد داخل الويندوز

ويمكن نسخ اي ملف فيه

جرب وضع القاعدة في مجلد عادي

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

مثلا جوجل بارتيشن هو G والمجلد backup

يكون مسار النسخ

g:\backup\

وبعدها اسم ملف القاعدة وامتداده

**abouelhassan** · أغسطس 10, 2021

6 ساعات مضت, د.كاف يار said:

لا اعلم ما السبب للأسف فاليس لدي توقعات لكن من الافضل ان تضع البرنامج خارج مجلد جوجل درايف

و تضع داخل الكود رابط مجلد جوجل درايف و هذا هو الاجراء السليم

بارك الله فيك استاذى انا اضع البرنامج على جوجل درايف لكى اتمكن من العمل فى المنزل عليه وفى العمل

اشكرك استاذى اشكرك من قلبى هحاول اشوف المشكلة بارك الله فيك يارب لا حرمنا منك ابداااااا

5 ساعات مضت, محمد أبوعبدالله said:

هل جربت الكود الذي ارفقته لك

اعتقدت ان الموضوع متعلق بصلاحيات ويندوز

ولكني جربت الكود الآن فلم تظهر مشكلة والحمد لله وتم عمل نسخة احتياطية بنجاح

تحياتي

اشكرك استاذى الحبيب نعم جربته يعمل بس نفس المشكلة بارك الله فيك اخى الغالى احترامى

33 دقائق مضت, أ / محمد صالح said:

جوجل درايف بارتيشن عبارة عن مجلد داخل الويندوز

ويمكن نسخ اي ملف فيه

جرب وضع القاعدة في مجلد عادي

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

مثلا جوجل بارتيشن هو G والمجلد backup

يكون مسار النسخ

نعم استاذى واعمل عليه وكل الاكواد تعمل تمام الا الحفظ النسخ الاحتياطى مش عارف ليه

شكر وتقدير من اخيك

**أ / محمد صالح** · أغسطس 11, 2021

5 ساعات مضت, abouelhassan said:

نعم استاذى واعمل عليه وكل الاكواد تعمل تمام الا الحفظ النسخ الاحتياطى مش عارف ليه

أخي الكريم لقد قمت بتحميل برنامج جوجل درايف للويندوز وجربت عليه ملفي الخاص بالنسخ الاحتياطي والضغط

ووجدت أنه يعمل بدون مشاكل

جرب هذا النموذج في برنامجك

بالتوفيق

**abouelhassan** · أغسطس 11, 2021

11 ساعات مضت, أ / محمد صالح said:

أخي الكريم لقد قمت بتحميل برنامج جوجل درايف للويندوز وجربت عليه ملفي الخاص بالنسخ الاحتياطي والضغط

ووجدت أنه يعمل بدون مشاكل

جرب هذا النموذج في برنامجك

بالتوفيق

بارك الله فيك استاذى الغالى هحاول الاستفادة من النموذج بحيث عند اغلاق البرنامج يتم عمل نسخة احتياطية فى فولدرbackub بجوار قاعدة البيانات

اشكرك استاذى الفاضل جزاك الله كل خير يارب

**abouelhassan** · أغسطس 13, 2021

في ٢٣‏/٧‏/٢٠٢١ at 03:22, د.كاف يار said:

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية

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, DataName As String
Dim Syso As Object

MyFile = CurrentProject.FullName
DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")"
DstFile = CurrentProject.Path & "\Backup\" & DataName & ".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] = DataName
        ![Backup_Path] = DstFile
        ![Backup_Date] = Now()
        .Update

    End With
    rs.Close
    Set rs = Nothing




MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد"

Exit Sub
ErrH:
Select Case Err.Number
End Select

السلام عليكم اساتذتى الافاضل

وضعت الكود تمام الحمد لله اصبح يعمل تمام تحت زر اسمه back up

ولكن لدى زر خروج اردت عند الضغط على خروج ان يعمل الكود

استخدمت الكود حيث ان backub_click هو اسم كود النسخة الاحتياطية بس لم يعمل مع الغلق

Private Sub BtnExit_Click()
Call Backub_Click
DoCmd.Quit

End Sub

هل امر call غلط شاكر فضلكم اخواتى الاساتذة الافاضل

تسجيل الدخول

كود نسخة احتياطية

الردود الموصى بها

abouelhassan

د.كاف يار

abouelhassan

د.كاف يار

abouelhassan

محمد أبوعبدالله

abouelhassan

عبد اللطيف سلوم

د.كاف يار

abouelhassan

Eng.Qassim

Eng.Qassim

محمد أبوعبدالله

Eng.Qassim

د.كاف يار

abouelhassan

د.كاف يار

abouelhassan

د.كاف يار

محمد أبوعبدالله

أ / محمد صالح

abouelhassan

أ / محمد صالح

abouelhassan

abouelhassan

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information