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

**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).rarFetching info...

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

في 23‏/7‏/2021 at 01:33, abouelhassan said:

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

Expand

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

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

**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

في 23‏/7‏/2021 at 03:59, محمد أبوعبدالله 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

تحياتي

Expand

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

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

في 23‏/7‏/2021 at 01: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

Expand

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

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

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

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

في 23‏/7‏/2021 at 10:23, عبد اللطيف سلوم said:

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

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

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

Expand

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

شكرا لك

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

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

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

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

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

في 23‏/7‏/2021 at 01: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

Expand

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

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

في 23‏/7‏/2021 at 03:59, محمد أبوعبدالله 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

تحياتي

Expand

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

لكن هناك نقص

Dim strFolderPath As String

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

في 9‏/8‏/2021 at 20:47, Eng.Qassim said:

لكن هناك نقص

Dim strFolderPath As String

Expand

متأكد ؟

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

في 10‏/8‏/2021 at 00:05, محمد أبوعبدالله said:

متأكد ؟

Expand

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

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

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

في 9‏/8‏/2021 at 19:57, abouelhassan said:

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

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

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

Expand

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

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

في 9‏/8‏/2021 at 20:42, Eng.Qassim said:

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

Expand

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

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

في 23‏/7‏/2021 at 01: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

Expand

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

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

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

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

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

في 10‏/8‏/2021 at 10:38, abouelhassan said:

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

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

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

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

Expand

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

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

في 10‏/8‏/2021 at 10:44, د.كاف يار said:

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

Expand

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

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

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

في 10‏/8‏/2021 at 14:21, abouelhassan said:

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

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

Expand

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

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

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

في 10‏/8‏/2021 at 14:21, abouelhassan said:

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

Expand

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

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

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

تحياتي

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

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

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

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

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

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

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

g:\backup\

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

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

في 10‏/8‏/2021 at 14:42, د.كاف يار said:

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

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

Expand

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

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

في 10‏/8‏/2021 at 16:15, محمد أبوعبدالله said:

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

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

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

تحياتي

Expand

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

في 10‏/8‏/2021 at 21:01, أ / محمد صالح said:

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

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

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

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

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

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

Expand

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

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

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

في 10‏/8‏/2021 at 21:38, abouelhassan said:

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

Expand

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

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

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

بالتوفيق

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

في 11‏/8‏/2021 at 03:36, أ / محمد صالح said:

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

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

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

بالتوفيق

Expand

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

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

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

في 23‏/7‏/2021 at 01: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

Expand

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

وضعت الكود تمام الحمد لله اصبح يعمل تمام تحت زر اسمه 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