السادة المحترمين
السلام عليكم ورحمة الله ...
برجاء مساعدتي
الملف المرفق به كود
function RunSub()BackUpEnd Function
يقوم بالنسخ الإحتياطي للملف عند الفتح بطريقة أوتو ماتيكية وتم تنفيذ الماكرو
Run codeRunSub()
وكان يعمل الماكرو بعد حفظه باسم
Autoexec
وقمت بإختباره وكان يعمل بطريقة صحيحه.....
وقمت مره اخرى بعمل نفس الكود والماكرو وفجأة اصابه عطل ولا ادري ما السبب عن توقف النسخ الإحتياطي في كل مره ...
تم تعديل هذه المشاركة بواسطة alaaaboulela في 8 مارس 2014 في 02:39
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
اخي الفاضل
وعليكم السلام ورحمة الله وبركاته
اين هو كود دالة النسخ الإحتياطي فلا يوجد لديك اي شيء
كود دالة BackUp يتكون حوالي من 20 سطر او اكثر وتكون في وحده نمطية مستقله لكي تقوم بإستدعاؤه من خلال ماكرو بدء التشغيل
حاول تبحث لديك في ملفاتك او في المنتدى عن دالة النسخ الإحتياطي ومن ثم تقوم بإستيرادها الى قاعدة بياناتك
بالتوفيق
والله يا استاذتي الكريمة بالفعل قام بعمل نسخة للملف بتاريخ اليوم بنفس هذه الطريقة ولكن لا ادري ماذا حدث عندما قمت باعادة تنفيذ الماكرو ولكن لا ادري ما حدث والخطأ الذي حدث ...
والطريقة حصلت عليها من فيديو باللغة الانجليزية ....
وعلى اي حال اتقدم بالشكر لحضرتك على سرعة استجابتك وردك على استفساري ....
تم تعديل هذه المشاركة بواسطة alaaaboulela في 8 مارس 2014 في 04:10
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
اخي الفاضل
مستحيل بارك الله بك ان يتم استدعاء دالة النسخ الإحتياطي اذا كانت الدالة اساسا غير موجوده
يجب ان تكون الدالة بهذه الطريقة في الوحدة النمطية ليتم استدعاؤها من خلال ماكرو بدء التشغيل
Public Function Backup() On Error GoTo Error_Handler Dim sFile As String, oDB As DAO.Database Dim strCurrentName As String Dim oTD As TableDef Dim qDF As QueryDef strCurrentName = Application.CurrentObjectName sFile = CurrentProject.Path & "\" & Left(CurrentProject.Name, Len(CurrentProject.Name) - 6) & " " & Format(Date, "dd-mm-yyyy") & ".accdb" If Dir(sFile) <> "" Then Kill sFile Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral) For Each qDF In CurrentDb.QueryDefs If Left(qDF.Name, 1) <> "~" Then DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acQuery, qDF.Name, qDF.Name, False End If Next qDF For Each oTD In CurrentDb.TableDefs If Left(oTD.Name, 4) <> "MSys" Then DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acTable, oTD.Name, oTD.Name, False End If Next oTD MsgBox " مبروك ... تم انشاء نسخة إحتياطية في نفس مجلد القاعدة بتاريخ اليوم ", vbInformation, "BackUp" Error_Handler_Exit: On Error Resume Next Set qDF = Nothing Set oTD = Nothing oDB.Close Exit Function Error_Handler: MsgBox "The following error has occured." & vbCrLf & vbCrLf & "Error Number: " & Err.Number, vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function
Function RunSub()Call BackupEnd Function
تم تعديل هذه المشاركة بواسطة zahrah في 8 مارس 2014 في 13:15
عندك حق استاذتي الفاضلة واعتذر عما حدث عن دون قصد مني و ربنا يسامحنا جميعاً عن الخطأ والنسيان ....
لقد تداركت الخطأ , الخطأ كان من عندي وهو
قبل كتابة الكود في الملف سبق وان قمت بعمل نسخة احتياطية من الملف بطريقة يدوية من خلال save and publish وذلك قبل
كتابة الكود من واقع الفيديو (الصورة الملحقة ) فهيئ لي ان الكود هو من صنع الملف ونسيت بانني قمت بعمل نسخة احتياطية بطريقة يدوية لاكثر من ملف كان من بينهم هذا الملف
الفيديو
الدقيقة 7:17
قمت بتجربة الملف المرفق من طرفكم ولكن يبدوا ان في مشكلة لدي في الملف تظهر رسالة ويقوم بعمل نسخة احياناً ولكن النسخة فارغه ولا يوجد بها أي شيء لا جداول ولا نماذج ....
تحياتي لك استاذتي الكريمة ومشكورة مقدماً وجزاكم الله كل خير ...
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
الرسالة الاولى 
الرسالة الثانية
هل المشكلة في مستوى الامان عندي ام مشكلة في الويندوز ؟؟؟؟
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
تفضل اخي الكريم
الملف بعد التعديل النهائي وهو يعمل بشكل صحيح 100%
ايضا تأكد من تخفيض مستوى امان الأكسيس لديك حتى يتم تمكين الماكرو والوحدات النمطية
بالتوفيق
اشكر حضرتك على مجهودك وتعبك معايا ربنا يجعله في ميزان حسناتك ويكرمك يا رب ....
هجرب واقول لحضرتك :)
.
.
.
جربت وتمام ...
رائع 100100100100 تسلم ايدك .... :)
بارك الله فيكي وفي صحتك وعمرك ...
تم تعديل هذه المشاركة بواسطة alaaaboulela في 8 مارس 2014 في 14:48
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
معلش سؤال كمان واستحملي فضولي ....
ما هو التعديل في حال وجود form ضمن قاعدة البيانات لان الكود يحتوي على عمل نسخة احتياطية من الاستعلامات والجداول وبحثت فيه لم اجد ما يخص النماذج ...
واعتذر عن ازعاجك بكثرة الطلبات....
تحياتي لحضرتك ...
تم تعديل هذه المشاركة بواسطة alaaaboulela في 8 مارس 2014 في 14:42
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
المرفق
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
اخي الفاضل
اذا رغبت في نسخة احتياطية لجميع كائنات قاعدة البيانات فسيكون الكود بهذه الطريقة
Public Function Backup() On Error GoTo Error_Handler Dim sFile As String, oDB As DAO.Database Dim strCurrentName As String Dim oTD As TableDef Dim qDF As QueryDef Dim obj As AccessObject strCurrentName = Application.CurrentObjectName sFile = CurrentProject.Path & "\" & Left(CurrentProject.Name, Len(CurrentProject.Name) - 6) & " " & Format(Date, "dd-mm-yyyy") & ".accdb" If Dir(sFile) <> "" Then Kill sFile Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral) 'الجداول For Each oTD In CurrentDb.TableDefs If Left(oTD.Name, 4) <> "MSys" Then DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acTable, oTD.Name, oTD.Name, False End If Next oTD 'الاستعلامات For Each qDF In CurrentDb.QueryDefs If Left(qDF.Name, 1) <> "~" Then DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acQuery, qDF.Name, qDF.Name, False End If Next qDF 'النماذج For Each obj In CurrentProject.AllForms DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acForm, obj.Name, obj.Name, False Next obj 'التقارير For Each obj In CurrentProject.AllReports DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acReport, obj.Name, obj.Name, False Next obj 'الماكرو For Each obj In CurrentProject.AllMacros DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acMacro, obj.Name, obj.Name, False Next obj 'الوحدات النمطية For Each obj In CurrentProject.AllModules DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acModule, obj.Name, obj.Name, False Next obj MsgBox " مبروك ... تم إنشاء نسخة احتياطية في نفس مجلد القاعدة بتاريخ اليوم ", vbInformation, "BackUp" Error_Handler_Exit: On Error Resume Next Set qDF = Nothing Set oTD = Nothing Set obj = Nothing oDB.Close Exit Function Error_Handler: MsgBox "The following error has occured." & vbCrLf & vbCrLf & "Error Number: " & Err.Number, vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function
ملفك بعد التعديل
بالتوفيق
شكرا جزيلا ممتن جداً لحضرتك تحياتي ...
"اللهم إني أسألك عملاً خالصاً لوجهك الكريم وأعوذ بك من النفاق والرياء "
قسم البرامج والتدريب ونظم المعلومات المحاسبية والكورسات المجانية
هذا الموضوع مغلق.
المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية
جارٍ التحقق من المتواجدين…
