اذهب الي المحتوي
أوفيسنا

كود نسخ احتياطي توقف عن العمل فجأة


إذهب إلى أفضل إجابة Solved by Moosak,

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

السلام عليكم

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

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

هل من المعقول انه بسبب زيادة حجم قاعدة البيانات ؟؟

Dim a As VbMsgBoxResult
a = MsgBox("هل تريد أخذ نسخة احتياطية قبل الخروج", vbInformation + vbMsgBoxRight + vbYesNoCancel, "تنبيه")
If a = vbYes Then
Dim OldFile, newfile, copymydb, nam
nam = "Acc_Tavuk_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) & ".ACC4"
OldFile = DLookup("[database]", "track", "[ForeignName]='bill'")
newfile = "E:\2022\tavuk" & "\" & nam
copymydb = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & newfile & """"
Shell copymydb, 0

DoCmd.Quit
ElseIf a = vbNo Then
DoCmd.Quit
End If

رسالة الخطأ

image.png.d3b3361cf1aed742b1ca24826e2f71d9.png

رابط هذا التعليق
شارك

  • أفضل إجابة

وعليكم السلام ورحمة الله وبركاته أخي عبدالله 🙂 

لو صورت الجزئية التي يقف عليها المؤشر بالأصفر عند الضغط على ال Debug

وعلى العموم يمكنك ببساطة تغيير الكود .. هناك الكثير من الأكواد التي تؤدي نفس العمل .. 🙂 

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

Public Sub Backupme()

On Error GoTo MyErr

Dim OldFile, NewFile, CopyMyDB, wheretoBackup, BackupFolder, DBName As String

    If IsNull(DLookup("Database", "MSysObjects", "Type=6")) Then
        OldFile = CurrentProject.FullName
        wheretoBackup = CurrentProject.Path
    Else
        OldFile = DLookup("Database", "MSysObjects", "Type=6")
        wheretoBackup = Left(OldFile, InStrRev(OldFile, "\"))
    End If

    BackupFolder = wheretoBackup & "\Backup"

On Error Resume Next
If Len(Dir(BackupFolder)) = 0 Then
    MkDir BackupFolder
    Else
    End If
On Error GoTo MyErr

    DBName = Left(CurrentProject.Name, InStrRev(CurrentProject.Name, ".") - 1)

NewFile = wheretoBackup & "\Backup\" & DBName & "-Backup-" & Format(Date, "dd-mm-yyyy") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(OldFile, 5)
CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0


MsgBox "Backup……..Done" & vbNewLine & vbNewLine & "Saved in :" & vbNewLine & NewFile, , " "

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

End Sub



'=======================================(كود آخر)
Public Function CreateBackup() As Boolean
Dim Source As String
Dim Target As String
Dim a As Integer
Dim objFSO As Object
Dim Path As String
Path = CurrentProject.Path  'get location of current folder
Source = CurrentDb.Name
Target = Path & "\BackupDB "
Target = Target & Format(Now(), "mm-dd") & ".accdb"

' create the backup
a = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
a = objFSO.CopyFile(Source, Target, True)
Set objFSO = Nothing
End Function

 

وهذا الكود للمهندس محمد عصام :

 

  • Like 2
رابط هذا التعليق
شارك

17 ساعات مضت, Moosak said:

هذا الكود الذي أستخدمه أنا ويعمل معي جيد ، الكود يأخذ نسخة لقاعدة البيانات كلها إذا كانت غير مقسمة .

ظهرت نفس رسالة الخطا للاسف

 

17 ساعات مضت, Moosak said:

و صورت الجزئية التي يقف عليها المؤشر بالأصفر عند الضغط على ال Debug

image.png.a48e45c835c3c5ce5538f0b464bc40e4.png

رابط هذا التعليق
شارك

18 ساعات مضت, Moosak said:
Public Function CreateBackup() As Boolean
Dim Source As String
Dim Target As String
Dim a As Integer
Dim objFSO As Object
Dim Path As String
Path = CurrentProject.Path  'get location of current folder
Source = CurrentDb.Name
Target = Path & "\BackupDB "
Target = Target & Format(Now(), "mm-dd") & ".accdb"

' create the backup
a = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
a = objFSO.CopyFile(Source, Target, True)
Set objFSO = Nothing
End Function

اما هذا الكود اشتغل بشكل جيد

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

رابط هذا التعليق
شارك

3 ساعات مضت, عبد الله قدور said:

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

بالمناسبة أخي عبدالله جربت الكود الخاص بك واشتغل معي تمام  .. ولكن مع بعض التعديلات والتي ربما هي سبب المشكلة عندك :

في 17‏/10‏/2022 at 16:57, عبد الله قدور said:
OldFile = DLookup("[database]", "track", "[ForeignName]='bill'")
newfile = "E:\2022\tavuk" & "\" & nam

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

رابط هذا التعليق
شارك

منذ ساعه, Moosak said:

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

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

رابط هذا التعليق
شارك

8 دقائق مضت, rockjone33 said:

لمسار خطأ fff. accdb/ الملف مكرر؟!  راجع صورة الكود اعلاه ☝️  وناقص كود تصحيح اذا كان الملف مفقود ينشأ ملف جديد مع تاريخ وترقيم ياخذ رقم +1 من المرفق السابق وليس الجدول او من جدول ترقيم الملف.. 

nam ملغي؟!!! 

كنت اشك في nam فاستبدله فلم يفلح الامر فنقلت الكود الى المنتدى قبل اعادته كمان كان 😅

رابط هذا التعليق
شارك

بالنسبة لاسم الملف nam يمكنك اختصاره هكذا ، مع تصحيح امتداد اسم الملف :

nam = "Acc_Tavuk_" & Format(Now,"dd-mm-yyyy_hh-nn-ss am/pm" & ".Accdb"

 

تم تعديل بواسطه Moosak
رابط هذا التعليق
شارك

11 دقائق مضت, Moosak said:

بالنسبة لاسم الملف nam يمكنك اختصاره هكذا ، مع تصحيح امتداد اسم الملف :

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

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

مثلا برنامج المحاسبة كل نسخه الاحتياطية تنتهي بامتداد acc4 اما برنامج الاحصاء كان امتداده amk وهكذا

 

رابط هذا التعليق
شارك

2 دقائق مضت, عبد الله قدور said:

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

ما شاء الله فكر أمني وطريقة جيدة للاحتراز من العبث 🙂 

وهل تقوم بتغيير الامتداد يدويا عند الاستعادة ؟

رابط هذا التعليق
شارك

8 دقائق مضت, Moosak said:

وهل تقوم بتغيير الامتداد يدويا عند الاستعادة ؟

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

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

بالنسبة لي اضع في حسباني دائما شيئين في تصميم البرنامج وبرمجته جعلاني اتقدم كثيرا في العمل

1- الحصول على برنامج باقل عدد نقرات ماوس ممكنة وسرعة وصول الى كل نافذة ومعلومة

2- اضع نصب عيني دائما ان هذا البرنامج لن اعمل عليه انا ، سيعمل عليه مستخدم اخر لا يعرف عن البرمجة شيء ويجب ان يكون كل شيء متاح له

 

تم تعديل بواسطه عبد الله قدور
  • Like 2
رابط هذا التعليق
شارك

14 ساعات مضت, عبد الله قدور said:

- الحصول على برنامج باقل عدد نقرات ماوس ممكنة وسرعة وصول الى كل نافذة ومعلومة

 

منذ ساعه, rockjone33 said:

لا يهم عدد الضربات الماوس!!

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

لذا كنت احرص على

  • استخدام مربعات النص بدلا من استخدام مربع التحرير والسرد بحيث يتم ادخال رقم القيمة بدلا من فتح القائمة المنسدلة والاختيار وطريقة مربعات النص تسهل كثير من عمليات الادخال وخلال فترة قصيرة يحفظ مدخل البيانات هذة الرموز وفي حالة عدم حفظ الرمز يضع المدخل رقم صفر فيتم فتح نموذج مساعد على وضع الفلترة للقيمة المطلوب ادخالها
  • برمجة مفاتيح الكييبورد لتنفيذ مهام معين يغني في حالات كثير عن استخدام الماوس
14 ساعات مضت, عبد الله قدور said:

اضع نصب عيني دائما ان هذا البرنامج لن اعمل عليه انا ، سيعمل عليه مستخدم اخر لا يعرف عن البرمجة شيء ويجب ان يكون كل شيء متاح له

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

تحياتي

  • Like 2
رابط هذا التعليق
شارك

3 دقائق مضت, مبرمج متقاعد said:

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

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

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

و برنامج اخر عندما تضغط اضافة تظهر لك رسالة هل تريد الاضافة تختار نعم فيتم الاضافة ثم رسالة تمت الاضافة بنجاح تختار نعم لاغلاق النافذة يجب ان تضغط جديد للانتقال الى فاتورة جديدة طبعا مع رسالة ثلاثة هل تريد فتح فاتورة جديدة ، تصور اني محاسب في شركة وعندي اضافة 200 فاتورة مبيعات و 50 سند قيد و 100 مشتريات بهذه الحالة عندي 1050 رسالة تحذير او تاكيد ، والله هذا يعتبر جريمة بحق مستخدم البرنامج

13 دقائق مضت, مبرمج متقاعد said:

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

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

  • Like 1
رابط هذا التعليق
شارك

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

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information