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

مطلوب طريقة حذف (الاستعلامات - النماذج - التقارير) برمجيا


Amr Ashraf
إذهب إلى أفضل إجابة Solved by رمهان,

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

السلام عليكم

اساتذتى الكرام عاوز كود عند تشغيله يحذف جميع الكائنات فى القاعدة استعلامات ونماذج وتقارير هل يوجد كود مثل هذا ؟ 

ملحوظة : محرر الفاجوال بيسك عليه باسوورد طبعا فى الطبيعى عملية الحذف مش هتتم غير لما افتح محرر الفاجوال واضع الباسوورد

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

متم بخير .. وتقبل منا ومنكم صالح الاعمال :fff:

 

 

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

اتفضل اليك وحدة نمطية هذا

Function DeleteAll()
On Error Resume Next
Dim db As Database
Dim idx As Long
Dim strName As String

Set db = CurrentDb
    ''Relationships
    For idx = db.Relations.Count - 1 To 0 Step -1
        strName = db.Relations(idx).Name

        If Left(strName, 4) <> "msys" Then
            db.Relations.Delete strName
        Else
            Debug.Print strName
        End If
    Next idx

    ''Forms
    For idx = CurrentProject.AllForms.Count - 1 To 0 Step -1
        strName = CurrentProject.AllForms(idx).Name
        DoCmd.DeleteObject acForm, strName
    Next idx
    
        ''Macros
    For idx = CurrentProject.AllMacros.Count - 1 To 0 Step -1
        strName = CurrentProject.AllMacros(idx).Name
        DoCmd.DeleteObject acMacro, strName
    Next idx

    ''Reports
    For idx = CurrentProject.AllReports.Count - 1 To 0 Step -1
        strName = CurrentProject.AllReports(idx).Name
        DoCmd.DeleteObject acReport, strName
    Next idx
    
    ''Queries
    For idx = db.QueryDefs.Count - 1 To 0 Step -1
        strName = db.QueryDefs(idx).Name
        If Left(strName, 4) <> "~sq_" Then
            db.QueryDefs.Delete strName
        Else
            Debug.Print strName
        End If
    Next idx
    
    ''Tables
    For idx = db.TableDefs.Count - 1 To 0 Step -1
        strName = db.TableDefs(idx).Name
        If Left(strName, 4) <> "msys" Then
            db.TableDefs.Delete strName
        Else
            Debug.Print strName
        End If
    Next idx

    ''Modules
    For idx = CurrentProject.AllModules.Count - 1 To 0 Step -1
        strName = CurrentProject.AllModules(idx).Name
        If strName <> "Module5" Then
            DoCmd.DeleteObject acModule, strName
        End If
    Next idx

End Function

وفي النموذج ليس لديه مصدر في خلف زر مثلا او اي حدث

اكتب

Call DeleteAll

 

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

10 ساعات مضت, Shivan Rekany said:

اكتب


Call DeleteAll

 

للاسف اخى شيفان لا تعمل انا قمت بالأتى عملت باسوورد لVba وجربت اشغل الكود ظهرت الرسالة التالية

Capture.PNG.18c3d502676f2ac028deb5c229da867f.PNG

 

حذفت الباسوورد وجربت الكود ظهرت رسالة اخرى

 

Capture2.PNG.ad9310c3d963f6768dfd748f3fc21d7a.PNG

 

اظن ان الطريقة مش هتشتغل فى حالة حماية الفاجول بيسك بكلمة سر

تقبل تحياتى :fff:

 

 

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

عزيزنا عمرو

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

ولكن اشارك هنا بحل مشكلة تعريف المتغبر db . جرب dim db as dao.database

تحياتي

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

الان, Amr Ashraf said:

للاسف اخى شيفان لا تعمل انا قمت بالأتى عملت باسوورد لVba

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

اي مثلا عدنا تقريرين و واحد من التقارير مثلا عند فتح بها كود في محرر فيجوال مثلا كود maximize 
ما يحذف هذا التقرير

والاخر ما بها اي اكواد داخل محرر فيجوال سيحذفه

اي ما يحذف اي من وحدات نمطية و النماذج اللي عندها كود في محرر فيجوال والتقارير ايضا

وسيحذف جميع الجداول والاستعلامات و ماكروات و سيحذف جميع نماذج اللي ما بها اي كود و التقارير

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

واليك قاعدة بيانات للتجربة

 

 

 

212.rar

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

15 ساعات مضت, Shivan Rekany said:

واليك قاعدة بيانات للتجربة

12.rar

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

سؤالى هنا هل هناك طريقة لتزويد الكود بكلمة مرور الفاجوال بيسك بحيث يفك الحماية عنه ثم يقوم بحذف النماذج والتقارير ؟

 مشكور اخى شيفان :fff:

19 ساعات مضت, رمهان said:

عزيزنا عمرو

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

ولكن اشارك هنا بحل مشكلة تعريف المتغبر db . جرب dim db as dao.database

تحياتي

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

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

سؤالى هنا هل هناك طريقة لتزويد الكود بكلمة مرور الفاجوال بيسك بحيث يفك الحماية عنه ثم يقوم بحذف النماذج والتقارير ؟

تحياتى لك :fff:

 

 

 

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

  • أفضل إجابة

مرحبا اخ عمرو

الحقيقة وجدت كود لا يجاد رسالة الباسسوورد ثم تمرير القيمة لها وهي اول ما خطر في بالي وهذا الرابط

http://www.siddharthrout.com/2013/04/24/unprotecting-vba-project-password-using-a-password-that-you-know/

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

الان جرب التالي

ضع دالة عامة كالتالي (طبعا قبل وضع الحماية):

Function ramhan(pass)
SendKeys "%{F11}%TE" & pass & "~~%{F11}", True
DoEvents
End Function

ثم تنادي الدالة من زر الامر الذي به حذف الكائن ممرا كلمة المرور وكاتالي مثلا حيث الباسسور=1 واسم التقرير rep1 به حدث عند التحميل

Private Sub Command0_Click()
Call ramhan("1")
DoCmd.DeleteObject acReport, "rep1"
End Sub

الان احفظ ثم ضع باسسورد للمشروع =1 

اغلق القاعدة وحاول الحذف عن طريق النافذة لن يقبل وسيقبل من خلال الزر

هنا ولو زبطت التجربة اعتقد انه موضوع جديد كليا وحماية جديدة نتمتع بها 

تحياتي

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information