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

[Shivan Rekany]

احبائي اعضاء المنتدى  اوفيسنا
السلام عليكم ورحمة الله وبركاته
في هذه الاونة الاخيرة اشوف ان كثير من احبائنا بيسئلون عن ضغط و اصلاح و نسخ الاحتياطية
لذلك قمت بدمج موضوعين واحد للسيد @أبو إبراهيم الغامدي والسيد @أ / محمد صالح
وتم اضافة ملح و و بهارات شوية واهديكم 
.......
الى الموضوع
هناك نموذجين بداخل القاعدة واحد اسمه 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 Rekany]

  في 9‏/9‏/2018 at 14:58, Khalf said:

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

سلمت يداك 

Expand  

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

  في 9‏/9‏/2018 at 15:16, ابو ياسين المشولي said:

بارك الله فيك

Expand  

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

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

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

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

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

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

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

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

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

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

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

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

[Shivan Rekany]

  في 9‏/9‏/2018 at 19:05, محمد التميمي said:

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

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

Expand  

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

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

  في 9‏/9‏/2018 at 20:48, أ / محمد صالح said:

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

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

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

Expand  

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

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

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

[Shivan Rekany]

  في 10‏/9‏/2018 at 06:39, أبو إبراهيم الغامدي said:

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

Expand  

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

[a.mannan100]

مرحبا ..

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

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

و شكرا

 

 

[محمد قاسم 12]

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

 

[محمد قاسم 12]

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

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

 

[Shivan Rekany]

  في 10‏/9‏/2018 at 08:20, a.mannan100 said:

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

Expand  

اهلا بك
الزر الاول يعطي الكود الاسفل للنسخة من نموذج 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

تقبل تحياتي

 

  في 10‏/9‏/2018 at 09:22, محمد قاسم 12 said:

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

Expand  

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

  في 10‏/9‏/2018 at 09:15, محمد قاسم 12 said:

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

Expand  

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

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