الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

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

بدأه zuabi76 في 20 مايو 2011 · 10 رد · 1,980 مشاهدة · في قواعد بيانات Microsoft Access
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

اخواني واخواتي اهل المنتدى الكرام، تحية عطرة وبعد

لدي قاعدة بيانات مقسمة وموضوعة على السيرفر، وأرغب بالحصول على كود يقوم بعمل:

1. نسخة احتياطية كل يوم الساعة 12 صباحا (اي عند بداية اليوم).

2. يتم النسخ لجزء الجداول فقط وبشكل تلقائي داخل مجلد محدد مسبقا وداخل مسار محدد على السيرفر.

3. تكون اسم النسخة هو تاريخ ووقت النسخة الاحتياطية، بهدف عدم حذف اي نسخة احتياطية موجودة داخل المجلد.

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

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

قاعدة البيانات.rar

#2

تفضل اخي

Call Shell("XCOPY /Y C:\mdb\mdb_BE.MDB D:\backup", 1)

#3

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

وجزاكم الله عني وعن امة المسلمين كل خير

#4

تفضل أخى

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

ضع الدالة فى النموذج أو وحدة نمطية

Public Function CompactBackendDatabaseFile_Custom(strPathFilename_OriginalBEDB As String, strPathFilename_TemporaryBEDB As String, blnKeepBackup As Boolean) As Integer

        ' strPathFilename_OriginalBEDB is the path and filename of the
        '      ACCESS file that you want to compact
        ' strPathFilename_TemporaryBEDB is the path and filename that
        '      you want the function to use for the temporary copy of
        '      the ACCESS file that the function will create as part
        '      of how the function does the compacting (NOTE: if you
        '      want to keep a copy of the backend file as a backup
        '      (archive) copy, the function will add a date/time
        '      stamp to the end of the filename)
        ' blnKeepBackup tells the function if you want to have it
        '      keep a copy of the ACCESS file as a backup copy or not
        '      (value of 0 or False tells the function to not keep
        '      a copy of the compacted file as a backup copy; -1 or
        '      True tells the function to keep a copy of the compacted
        '      file as a backup copy)

        ' The function returns an INTEGER value:
        '       -1     If a "lock file" (".ldb") exists for the original file, indicating that the
        '                     file is in use (no compaction was done)
        '        0     If no errors were encountered during the compaction process
        '        1     If the original file cannot be found (no compaction done)
        '        2     If an error was encountered during the compaction (no compaction done)

        Dim intLocation As Integer
        Dim xlngLooping As Long
        Dim strTempBEDB As String, strTemp As String
        Dim strDrive As String, strDateTime As String

        Const strLockFileExtension As String = "ldb"

        On Error Resume Next

        strDateTime = Format(Now, "dd mm yyyy _ hh nn ss AmPm")
        strTempBEDB = strPathFilename_TemporaryBEDB
        intLocation = InStrRev(strTempBEDB, "\")
        strTempBEDB = Left(strTempBEDB, intLocation) & strDateTime & _
              Mid(strTempBEDB, intLocation + 1)

        If Dir(Left(strPathFilename_OriginalBEDB, Len(strPathFilename_OriginalBEDB) - 3) & _
              strLockFileExtension) = "" Then

              On Error GoTo Err_Compact_1

              Name strPathFilename_OriginalBEDB As strTempBEDB
              DoEvents

              On Error GoTo Err_Compact_2

              DBEngine.CompactDatabase strTempBEDB, strPathFilename_OriginalBEDB
              DoEvents
              Do Until Dir(strPathFilename_OriginalBEDB) <> ""
                    On Error Resume Next
                    For xlngLooping = 0 To 25
                          DoEvents
                   Next xlngLooping
              Loop

              On Error Resume Next

              If blnKeepBackup = False Then _
                    Kill strTempBEDB

              CompactBackendDatabaseFile_Custom = 0

        Else
              CompactBackendDatabaseFile_Custom = -1

        End If

Exit_Compact:
              Exit Function


Err_Compact_1:
              On Error Resume Next
              MsgBox "The original database file cannot be found at this location:" & _
                    vbCrLf & " " & strPathFilename_OriginalBEDB & vbCrLf & _
                   "The file cannot be compacted.", vbExclamation, "Cannot Find The File!"
             CompactBackendDatabaseFile_Custom = 1
             Resume Exit_Compact


Err_Compact_2:
              On Error Resume Next
              Kill strPathFilename_OriginalBEDB
              FileCopy strTempBEDB, strPathFilename_OriginalBEDB
              MsgBox "An error occurred during the compacting operation of the file!" & _
                    vbCrLf & _
                    "The file cannot be compacted.", vbExclamation, "File Compaction Error!"
              CompactBackendDatabaseFile_Custom = 2
              Resume Exit_Compact

        End Function

و لا ستدعاء الدالة فى تمام الساعة الثانية عشرة صباحا

تحتاج الى وضع الكود فى حدث عند عداد الوقت للنموذج

لاتنسى أن تغير المسار لما لديك

لكلا من قاعدة الجداول و المسار الذى سيتم حفظ النسخ الاحتياطية به ( فى الكود قاعدة الجداول فى نفس مجلد الواجهة و مجلد النسخ الاحتياطية backups فى نفس المجلد أيضا )

لاحظ أيضا "backups\.mdb" هنا لم أضع اسم للنسخة الاحتياطية حتى يكون الاسم بالتاريخ و الوقت ****** لو تم وضع اسم سيتم اضافة الوقت و التاريخ له

Private Sub Form_Timer()
If Format(Time(), "hh:nn:ss") = "00:00:00" Then
Dim x
x = CompactBackendDatabaseFile_Custom(CurrentProject.Path & "\ab_be.mdb", CurrentProject.Path & "\backups\.mdb", True)
End If
End Sub

ملحوظة أخيرة

لاتنسى أن تضع timer interval=1000

فى النهاية نسألكم الدعاء

و بالتوفيق

مدونتى:-

احترف الأكسس مع أبو يوسف

متغيب حاليا لانشغالى الشديد

#5
Abo_Yossof كتب:

تفضل أخى

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

ضع الدالة فى النموذج أو وحدة نمطية

Public Function CompactBackendDatabaseFile_Custom(strPathFilename_OriginalBEDB As String, strPathFilename_TemporaryBEDB As String, blnKeepBackup As Boolean) As Integer

        ' strPathFilename_OriginalBEDB is the path and filename of the
        '      ACCESS file that you want to compact
        ' strPathFilename_TemporaryBEDB is the path and filename that
        '      you want the function to use for the temporary copy of
        '      the ACCESS file that the function will create as part
        '      of how the function does the compacting (NOTE: if you
        '      want to keep a copy of the backend file as a backup
        '      (archive) copy, the function will add a date/time
        '      stamp to the end of the filename)
        ' blnKeepBackup tells the function if you want to have it
        '      keep a copy of the ACCESS file as a backup copy or not
        '      (value of 0 or False tells the function to not keep
        '      a copy of the compacted file as a backup copy; -1 or
        '      True tells the function to keep a copy of the compacted
        '      file as a backup copy)

        ' The function returns an INTEGER value:
        '       -1     If a "lock file" (".ldb") exists for the original file, indicating that the
        '                     file is in use (no compaction was done)
        '        0     If no errors were encountered during the compaction process
        '        1     If the original file cannot be found (no compaction done)
        '        2     If an error was encountered during the compaction (no compaction done)

        Dim intLocation As Integer
        Dim xlngLooping As Long
        Dim strTempBEDB As String, strTemp As String
        Dim strDrive As String, strDateTime As String

        Const strLockFileExtension As String = "ldb"

        On Error Resume Next

        strDateTime = Format(Now, "dd mm yyyy _ hh nn ss AmPm")
        strTempBEDB = strPathFilename_TemporaryBEDB
        intLocation = InStrRev(strTempBEDB, "\")
        strTempBEDB = Left(strTempBEDB, intLocation) & strDateTime & _
              Mid(strTempBEDB, intLocation + 1)

        If Dir(Left(strPathFilename_OriginalBEDB, Len(strPathFilename_OriginalBEDB) - 3) & _
              strLockFileExtension) = "" Then

              On Error GoTo Err_Compact_1

              Name strPathFilename_OriginalBEDB As strTempBEDB
              DoEvents

              On Error GoTo Err_Compact_2

              DBEngine.CompactDatabase strTempBEDB, strPathFilename_OriginalBEDB
              DoEvents
              Do Until Dir(strPathFilename_OriginalBEDB) <> ""
                    On Error Resume Next
                    For xlngLooping = 0 To 25
                          DoEvents
                   Next xlngLooping
              Loop

              On Error Resume Next

              If blnKeepBackup = False Then _
                    Kill strTempBEDB

              CompactBackendDatabaseFile_Custom = 0

        Else
              CompactBackendDatabaseFile_Custom = -1

        End If

Exit_Compact:
              Exit Function


Err_Compact_1:
              On Error Resume Next
              MsgBox "The original database file cannot be found at this location:" & _
                    vbCrLf & " " & strPathFilename_OriginalBEDB & vbCrLf & _
                   "The file cannot be compacted.", vbExclamation, "Cannot Find The File!"
             CompactBackendDatabaseFile_Custom = 1
             Resume Exit_Compact


Err_Compact_2:
              On Error Resume Next
              Kill strPathFilename_OriginalBEDB
              FileCopy strTempBEDB, strPathFilename_OriginalBEDB
              MsgBox "An error occurred during the compacting operation of the file!" & _
                    vbCrLf & _
                    "The file cannot be compacted.", vbExclamation, "File Compaction Error!"
              CompactBackendDatabaseFile_Custom = 2
              Resume Exit_Compact

        End Function

و لا ستدعاء الدالة فى تمام الساعة الثانية عشرة صباحا

تحتاج الى وضع الكود فى حدث عند عداد الوقت للنموذج

لاتنسى أن تغير المسار لما لديك

لكلا من قاعدة الجداول و المسار الذى سيتم حفظ النسخ الاحتياطية به ( فى الكود قاعدة الجداول فى نفس مجلد الواجهة و مجلد النسخ الاحتياطية backups فى نفس المجلد أيضا )

لاحظ أيضا "backups\.mdb" هنا لم أضع اسم للنسخة الاحتياطية حتى يكون الاسم بالتاريخ و الوقت ****** لو تم وضع اسم سيتم اضافة الوقت و التاريخ له

Private Sub Form_Timer()
If Format(Time(), "hh:nn:ss") = "00:00:00" Then
Dim x
x = CompactBackendDatabaseFile_Custom(CurrentProject.Path & "\ab_be.mdb", CurrentProject.Path & "\backups\.mdb", True)
End If
End Sub

ملحوظة أخيرة

لاتنسى أن تضع timer interval=1000

فى النهاية نسألكم الدعاء

و بالتوفيق

#6

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

1. الكود الخاص بالدالة والذي سأضعه في وحده نمطيه، هل مطلوب اجراء تعديل عليه أم انسخه مثل ما هو بدون تعديلات، وهل هناك اسم معين للوحده النمطية؟

2. هل ستتم عملية النسخ بشكل سليم لو احد المستخدمين في ذلك الوقت يستخدم الجزء الخاص بالواجهات والمرتبطه بدورها بالجداول، واذا كان الجواب لا فما الحل؟

3. جميع الأكواد الذي كتبتها حضرتك هل أقوم بوضعها داخل قاعدة البيانات التي تحتوي على الجداول فقط (الموجوده على السيرفر)؟

4. اشرت الى تغير المسار، هل تغير المسار في الأكواد أدناه فقط، وهل انا بحاجه لعمل نموذج لوضع الكود فيه؟

Private Sub Form_Timer()

If Format(Time(), "hh:nn:ss") = "00:00:00" Then

Dim x

x = CompactBackendDatabaseFile_Custom(CurrentProject.Path & "\ab_be.mdb", CurrentProject.Path & "\backups\.mdb", True)

End If

End Sub

5. مع العلم بأن قاعدة البيانات الخاصة بالجداول والموجوده على السيرفر ستكون مغلقه، هل سيعمل الكود بهذه الحالة بشكل تلقائي؟

أعرف انني اثقلتك بكثرة الأسئلة، ولكن اعذرني، وجزاك الله كل خير وبارك الله فيك

#7
zuabi76 كتب:

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

1. الكود الخاص بالدالة والذي سأضعه في وحده نمطيه، هل مطلوب اجراء تعديل عليه أم انسخه مثل ما هو بدون تعديلات، وهل هناك اسم معين للوحده النمطية؟

2. هل ستتم عملية النسخ بشكل سليم لو احد المستخدمين في ذلك الوقت يستخدم الجزء الخاص بالواجهات والمرتبطه بدورها بالجداول، واذا كان الجواب لا فما الحل؟

3. جميع الأكواد الذي كتبتها حضرتك هل أقوم بوضعها داخل قاعدة البيانات التي تحتوي على الجداول فقط (الموجوده على السيرفر)؟

4. اشرت الى تغير المسار، هل تغير المسار في الأكواد أدناه فقط، وهل انا بحاجه لعمل نموذج لوضع الكود فيه؟

Private Sub Form_Timer()

If Format(Time(), "hh:nn:ss") = "00:00:00" Then

Dim x

x = CompactBackendDatabaseFile_Custom(CurrentProject.Path & "\ab_be.mdb", CurrentProject.Path & "\backups\.mdb", True)

End If

End Sub

5. مع العلم بأن قاعدة البيانات الخاصة بالجداول والموجوده على السيرفر ستكون مغلقه، هل سيعمل الكود بهذه الحالة بشكل تلقائي؟

أعرف انني اثقلتك بكثرة الأسئلة، ولكن اعذرني، وجزاك الله كل خير وبارك الله فيك

أخى الكريم

1- الدالة لا تحتاج الى تعديل و يمكن وضعه فى نموذج أو فى أى وحدة نمطية

2- للاسف لن يتم النسخ اذا كانت القاعدة ( الجداول ) قيد الاستخدام و الحل هو خروج جميع المستخدمين أولا

3- الالكواد يتم وضعها فى الواجهة و ليس بقاعدة الجداول ( عند المستخدم الرئيسى و ليس كل المستخدمين )

4- تحتاج الى نموذج ( مفتوح باستمرار ) لكى يحسب الوقت و ليكن النموذج الرئيسى مثلا

مدونتى:-

احترف الأكسس مع أبو يوسف

متغيب حاليا لانشغالى الشديد

#8

يمكنك أخى استخدام طريقة النسخ أخى بدلا من الضغط

لانها تعمل مع بقاء القاعدة مستخدمة .

مدونتى:-

احترف الأكسس مع أبو يوسف

متغيب حاليا لانشغالى الشديد

#9
Abo_Yossof كتب:

يمكنك أخى استخدام طريقة النسخ أخى بدلا من الضغط

لانها تعمل مع بقاء القاعدة مستخدمة .

هل لا تكرمت علي بكود النسخ من بعد اذنك

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

#10

اليك أخى ما تريد

المرفق به تطبيق لما ذكرت

استورد الوحدة النمطية الى برنامجك ( الواجهة ) -----> لابد ان يكون النموذج مفتوح لكى يعمل الكود

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

الجد

قاعدة البيانات.rar

مدونتى:-

احترف الأكسس مع أبو يوسف

متغيب حاليا لانشغالى الشديد

#11

جزاك الله كل خير على مساعدتك التي تكرمت بها علي، سأقوم بتجربتها وسأخبرك بالنتائج إن شاء الله

مواضيع مشابهة

عدد الزوار حالياً

المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

جارٍ التحقق من المتواجدين…