هدية : عمل نسخة احتياطية في مجلد خاص و ضغط و اصلاح عند الاغلاق

[Shivan Kurdi]

احبائي اعضاء المنتدى  اوفيسنا
السلام عليكم ورحمة الله وبركاته
في هذه الاونة الاخيرة اشوف ان كثير من احبائنا بيسئلون عن ضغط و اصلاح و نسخ الاحتياطية
لذلك قمت بدمج موضوعين واحد للسيد @أبو إبراهيم الغامدي والسيد @أ / محمد صالح
وتم اضافة ملح و و بهارات شوية واهديكم 
.......
الى الموضوع
هناك نموذجين بداخل القاعدة واحد اسمه Frm1 والاخر Form1 
وفي نموذج Form1 هناك زرين
الاول كتبت عليه ( قم بعمل كومباكت و نسخة احتياطية  عند الاغلاق )

اي اذا ضغطت علي و في النهاية قمت باغلاق القاعدة 
اولا سيعمل نسخة احتياطية و بعدين سيعمل كومباكت اي ضغط و اصلاح القاعدة 
--------
اما الزر الثاني انا كتبت عليه ( الغي عمل كومباكت و نسخة احتياطية  عند الاغلاق )
اي اذا ضغطت على الزر الاول وبعدين غيرت رأيك بعمل نسخة احتياطية او عمل كومباكت اي ضغط واصلاح القاعدة تقدر ان تضغط اليه واذا اغلقت القاعدة ما بيعمل كمباكت و نسخة الاحتياطية
واستخدمنا هذه الاكواد في وحدة نمطية
 

Option Compare Database
Dim F As New Form_Frm1

Public Function Startup()
On Error Resume Next
  F.OnClose = "=BackUpMyDb()" & "=CopactMyDb()"
End Function

Public Function CnacelStartup()
On Error Resume Next
  F.OnClose = ""
End Function

Public Function BackUpMyDb()
Dim MyPath As String, math1 As String, math2 As String
    math1 = CurrentProject.Path
    math2 = math1 & "\MyProg"
    MyPath = math2 & "\BackUpSaved"
On Error GoTo MyErr
    Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB, TypeApp
        OldFile = CurrentDb.Name
        DBwithEXT = Dir(OldFile)
    If Right(DBwithEXT, 5) = "accdb" Then
            DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6)
            TypeApp = ".Accdb"
        ElseIf Right(DBwithEXT, 3) = "Mdb" Then
            DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)
            TypeApp = ".Mdb"
    End If
    If Dir(math2, vbDirectory) = "" Then MkDir math2
    If Dir(MyPath, vbDirectory) = "" Then MkDir MyPath
        NewFile = MyPath & "\" & DBwithoutEXT & "-" & Format(Now, "yyyy-mm-dd-Hh-Nn-Ss") & TypeApp
        CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
        Shell CopyMyDB, 0
MyErr:
    If Err.Number <> 0 Then
        MsgBox Err.Number & " - " & Err.Description
    End If

End Function
Public Function compactDb(ByVal mydb As String, ByVal mypass As String, Optional openIt As Boolean = False)
    Dim F As Integer
    Dim filenoext As String, extension As String, Access As String
        Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE"""
        filenoext = Left(mydb, InStrRev(mydb, "."))
        extension = Right(mydb, Len(mydb) - InStrRev(mydb, "."))
        F = FreeFile
    Open CurrentProject.Path & "\compact.bat" For Output As F
    'wait until the Db closes (ldb file is gone), then compact it
        Print #F, "CHCP 1256"
        Print #F, ":checkldb1"
        Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb1"
        Print #F, Access & " """ & mydb & """" & mypass & " /compact"
    If openIt Then
    'wait until the Db closes, then start it
        Print #F, ":checkldb2"
        Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb2"
        Print #F, Access & " """ & mydb & """"
    Else
        Print #F, "del ""%~f0"""
    End If
        Close F
End Function

Public Function CopactMyDb()
On Error Resume Next
    Dim MyPath As String
        MyPath = CurrentProject.Path & "\" & CurrentProject.Name
        Call compactDb(MyPath, "", True)
        Shell """" & Left(MyPath, InStrRev(MyPath, "\")) & "\compact.bat""", 0
        DoCmd.Quit acQuitSaveAll
End Function

واليكم القاعدة

 

compactInClose.accdb

[Hamdi Edlbi-khalf]

دائماً سباق للخير

سلمت يداك 

[ابو ياسين المشولي]

بارك الله فيك

[Shivan Kurdi]

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

دائماً سباق للخير

سلمت يداك 

تسلم اخي الحبيب ... شكرا لك

1 ساعه مضت, ابو ياسين المشولي said:

بارك الله فيك

بارك الله فيك و فينا اجمعين ... شكرا 

[محمد التميمي]

تسلم اخي شفان وبارك الله بجهودك القيمة

لاكن عندي سؤال :

هل من الممكن تغير كد الزر الثاني الذي يحمل عبارة ( الغي عمل كومباكت و نسخة احتياطية  عند الاغلاق )

وجعله باستطاعتة استعادة النسخة الاحتياطية .

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

شوية بعد ضيف لها ملح وبهارات اتصير الذ واطعم ياطيب

[أ / محمد صالح]

جميل جدا أستاذ شيفان

وهذا هو دورنا جميعا تطويع الأكواد لما يناسب احتياجاتنا مع المزيد من التطوير

وفقنا الله جميعا لكل ما يحب ويرضى

[Shivan Kurdi]

10 ساعات مضت, محمد التميمي said:

هل من الممكن تغير كد الزر الثاني الذي يحمل عبارة ( الغي عمل كومباكت و نسخة احتياطية  عند الاغلاق )

وجعله باستطاعتة استعادة النسخة الاحتياطية .

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

و نقدر ان نعمل كما تفضلت لكن ليس في هذا الموضوع 
وشكرا لمداخلك

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

جميل جدا أستاذ شيفان

وهذا هو دورنا جميعا تطويع الأكواد لما يناسب احتياجاتنا مع المزيد من التطوير

وفقنا الله جميعا لكل ما يحب ويرضى

شكرا لك استاذي الحبيب
اللهم امين اجمعين

[أبو إبراهيم الغامدي]

دائما شفرات وبهارت الاستاذ شيفان لذيذة ومحبوبة للجميع..

[Shivan Kurdi]

2 دقائق مضت, أبو إبراهيم الغامدي said:

دائما شفرات وبهارت الاستاذ شيفان لذيذة ومحبوبة للجميع..

افتخر بك استاذي الحبيب , وين كنت كان غايب من زمان 
و شكرا لك

[a.mannan100]

مرحبا ..

شكرا ع المجهود الرائع

ممكن بشرح بسيط .. شؤح ربط الوحدة النمطية مع الزر في النموذج

و شكرا

 

 

[محمد قاسم 12]

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

 

[محمد قاسم 12]

استاذى الفاضل

هل من الممكن اضافه زر ثالث للضغ لمره واحده عند الغلق 

 

[Shivan Kurdi]

2 ساعات مضت, a.mannan100 said:

شؤح ربط الوحدة النمطية مع الزر في النموذج

اهلا بك
الزر الاول يعطي الكود الاسفل للنسخة من نموذج Frm1 اللي اسمه F
 

Public Function Startup()
	On Error Resume Next 
		F.OnClose = "=BackUpMyDb()" & "=CopactMyDb()" 
End Function

والزر الثاني يعطي الكود الاسفل اي يبدل الكود للنموذج F ب لا شيء
 

Public Function CnacelStartup()
	On Error Resume Next 
		F.OnClose = "" 
End Function

تقبل تحياتي

 

منذ ساعه, محمد قاسم 12 said:

هل من الممكن اضافه زر ثالث للضغ لمره واحده عند الغلق 

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

منذ ساعه, محمد قاسم 12 said:

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

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

تم تعديل سبتمبر 10, 2018 بواسطه Shivan Rekany