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

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

قام بنشر

وعليكم السلام ورحمة الله ..... أذا كان المقصد تفريغ ( مسح ) فتفضل 

في ١‏/٧‏/٢٠١٨ at 23:08, jjafferr said:

وعليكم السلام:smile:

 

غالبا لتصغير البرنامج ، عمل ضغط واصلاح يكون كافي.

 

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

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

ولاحظ بأني استخدمت طريقة اخوي @kanory ، لأني ما اريد احصل على رسائل اكسس ،

ومن ضمن الرسائل ممكن تكون رسالة بعدم امكانية حذف بيانات جدول بسبب ارتباطه بجدول آخر !! :


Sub AllTables()
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentData

    For Each obj In dbs.AllTables
       'docmd.setwarning false
       'docmd.runsql("Delete * From " & obj.Name
       'docmd.setwarning true

        dbs.execute("Delete * From " & obj.Name
    Next obj

End Sub

.

وبعد هذا اعمل ضغط واصلاح.

 

جعفر

 

 

 

  • Like 1
  • Thanks 1
قام بنشر
10 دقائق مضت, bouchaib zakaria said:

شكرا لتفاعلك اخ جعفر 

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

قام بنشر
منذ ساعه, bouchaib zakaria said:

 

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

 

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

  • Thanks 1
قام بنشر (معدل)

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

تم تعديل بواسطه bouchaib zakaria
  • Thanks 1
قام بنشر

تستطيع حسب حاجتك:

ضع تحت زر امر مع تغيير مسمى الجداول بما يناسبك

 

On Error GoTo Err_Handler

With CurrentDb
.Execute "DELETE * FROM Tbl1", dbFailOnError
.Execute "DELETE * FROM Tbl2", dbFailOnError
'بنفس الطريقة تستطيع اضافة اي جدول سواء حذف او تحديث 
End With

Err_Handler:
If err <> 0 Then
MsgBox err.desc & " (" & err.Number & ")"
err.Clear
Exit Sub
Else
'MsgBox "All Deleted", vbInformation, "Deleted"
End If

 

  • Like 1
  • Thanks 2
قام بنشر

جرب هذا الكود وإن شاء الله سيفلح معك
 

Dim T As TableDef
DoCmd.SetWarnings False
For Each T In CurrentDb.TableDefs
    If T.Name Like "d2s_*" Then
        DoCmd.RunSQL "DELETE * FROM " & T.Name
    End If
Next T
DoCmd.SetWarnings True

 

  • Thanks 2
قام بنشر (معدل)

انا عندي 7 جداول اقوم بتفريغهم بكبسة زر واحده 

الطريقة كالتالي 

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

ثم بعد ذلك ضع زر اين ما تريد 

وعند النقر شغل الاستعلام 

طريقة مجربة وسهلة 

حذف.jpg

حذف1.jpg

تم تعديل بواسطه عبد اللطيف سلوم
  • Like 1
  • Thanks 1
  • 3 weeks later...
قام بنشر
3 ساعات مضت, bouchaib zakaria said:

 

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

انفضل اخي هذا كود يحذف كل الجداول الموجوده بالقاعده

ماعليلك سوى تغير مسار القاعده وصيغتها مثلا انا عمامل mdb

Dim x
Beep
x = MsgBox(" سـوف يـتـم حـذف كـل الـبـيـانـات الـمـسـجـلـة سـتـفـقـد كـل شـي هـل تـريـد الاسـتـمرار  " & vbCrLf & "", vbYesNo, "           بـرنـامـج الـخـيـاط      ")
Dim strSQL As String
Dim tdf As TableDef
Dim BackDB As DAO.Database
Dim strPath As String
strPath = CurrentProject.Path & "\data\tailor.mdb"
Set BackDB = OpenDatabase(strPath)
For Each tdf In BackDB.TableDefs
If Not (Left(tdf.NAME, 4)) = "MSys" Then
BackDB.Execute ("delete * from " & tdf.NAME)
strSQL = "INSERT INTO " & tdf.NAME & " SELECT " & tdf.NAME & ".* FROM " & tdf.NAME & " IN '" & myfile & "';"
BackDB.Execute (strSQL)
End If
Next
DoCmd.Requery
MsgBox "  تـم  حـذف كـل الـبـيـانـات الـمـسـجـلـة بـنـجـاح", vbInformation, "           بـرنـامـج الـخـيـاط     "
BackDB.Close

 

  • Thanks 1
قام بنشر
4 ساعات مضت, bouchaib zakaria said:

 

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

العلاقات ليس لها علاقة

انت ما اعرفت تعمل استعلام حذف

نزل القاعدة والكل رح يساعدك

  • Thanks 1
  • 2 weeks later...
قام بنشر

السلام عليكم:smile:

 

في ١‏/٨‏/٢٠١٨ at 03:09, عبد اللطيف سلوم said:

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

اخي عبد اللطيف

طريقتك غير متعارف عليها ، والظاهر انك لم تستطع تنفيذها في مثال الاخ bouchaib zakaria !!

فالمثال الذي ارفقته هو استعلام حذف عادي ، واحد لكل جدول:smile:

 

 

الطريقة الاسهل هي ، عمل زر في نموذج ، وضع عليه هذا الكود لحذف سجلات جميع الجداول (وهذا الكود الذي اشار عليه بقية الشباب في مشاركاتهم ، بطرق مختلفة:smile:)

Private Sub cmd_Delete_All_Records_Click()
    
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentData

    For Each obj In dbs.AllTables

        If Left(obj.Name, 4) <> "MSys" Then
            
            DoCmd.SetWarnings False
                DoCmd.RunSQL ("Delete * From " & obj.Name)
            DoCmd.SetWarnings True
            
        End If
        
    Next obj
    
    MsgBox "تم حذف سجلات جميع الجداول"
    
End Sub

 

جعفر

 

951.استعلام حذف.accdb.zip

  • Like 2
  • Thanks 1
قام بنشر
2 ساعات مضت, jjafferr said:

السلام عليكم:smile:

 

اخي عبد اللطيف

طريقتك غير متعارف عليها ، والظاهر انك لم تستطع تنفيذها في مثال الاخ bouchaib zakaria !!

فالمثال الذي ارفقته هو استعلام حذف عادي ، واحد لكل جدول:smile:

 

 

الطريقة الاسهل هي ، عمل زر في نموذج ، وضع عليه هذا الكود لحذف سجلات جميع الجداول (وهذا الكود الذي اشار عليه بقية الشباب في مشاركاتهم ، بطرق مختلفة:smile:)


Private Sub cmd_Delete_All_Records_Click()
    
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentData

    For Each obj In dbs.AllTables

        If Left(obj.Name, 4) <> "MSys" Then
            
            DoCmd.SetWarnings False
                DoCmd.RunSQL ("Delete * From " & obj.Name)
            DoCmd.SetWarnings True
            
        End If
        
    Next obj
    
    MsgBox "تم حذف سجلات جميع الجداول"
    
End Sub

 

جعفر

 

951.استعلام حذف.accdb.zip

استاذ جعفر jjafferr

اذا كانت القاعدة منقسمه

واريد ان يستثني جدول ما

كيف الطريقة

قام بنشر

نفس الطريقة ، ولكن اضف اسم الجدول في هذا السطر (مثلا لا نريد الجدول tbl_one ) :

If Left(obj.Name, 4) <> "MSys" or obj.name <> "tbl_one" Then

 

جعفر

قام بنشر
20 دقائق مضت, jjafferr said:

نفس الطريقة ، ولكن اضف اسم الجدول في هذا السطر (مثلا لا نريد الجدول tbl_one ) :


If Left(obj.Name, 4) <> "MSys" or obj.name <> "tbl_one" Then

 

جعفر

للاسف اخي جعفر لم يتم حذف اي جدول

قام بنشر

للاسف لم يضبط معي

للمعلوميه

انا قاعدتي منقسمه

واريد احذف كل الجداول بستثناء جدول

usre

عندي كود يحذف كل الجداول

هذا الكود

كيف اضيف له شرط يسثني جدول

Dim strSQL As String
Dim tdf As TableDef
Dim BackDB As DAO.Database
Dim strPath As String
strPath = CurrentProject.Path & "\data\tailor"
Set BackDB = OpenDatabase(strPath)
For Each tdf In BackDB.TableDefs
If Not (left(tdf.NAME, 4)) = "MSys" And tdf.NAME <> "User" Then
BackDB.Execute ("delete * from " & tdf.NAME)
strSQL = "INSERT INTO " & tdf.NAME & " SELECT " & tdf.NAME & ".* FROM " & tdf.NAME & " IN '" & myfile & "';"
BackDB.Execute (strSQL)
End If
Next
 DoCmd.Requery
BackDB.Close
Me.Refresh
End If

 

  • Like 1
قام بنشر
23 دقائق مضت, jjafferr said:

خطأ مطبعي:blink:

 

بدل Or اكتب And ، هكذا:


If Left(obj.Name, 4) <> "MSys" AND obj.name <> "tbl_one" Then

 

شكرا اخي جعفر

استخدمت الكود حقي وكانت النتيجه المطلوبه

If Not (left(tdf.NAME, 4)) = "MSys" And tdf.NAME <> "User" Then

46 دقائق مضت, jjafferr said:

نفس الطريقة ، ولكن اضف اسم الجدول في هذا السطر (مثلا لا نريد الجدول tbl_one ) :


If Left(obj.Name, 4) <> "MSys" or obj.name <> "tbl_one" Then

 

جعفر

للاسف اخي جعفر لم يتم حذف اي جدول

قام بنشر

اخوي ابو ياسين

 

1. قلت لك لا تستعمل

If Left(obj.Name, 4) <> "MSys" or obj.name <> "tbl_one" Then

وانما استعمل

If Left(obj.Name, 4) <> "MSys" And obj.name <> "tbl_one" Then

 

2. الكود اللي انا وضعته هو تقريبا نفس الكود اللي انت وضعته ، بإستثناء ، ان الكود حقي يجب ان يكون في البرنامج اللي فيه الجداول (سواء مضمنه او مربوطة) وتريد تحذف سجلاتها ،

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

 

جعفر

قام بنشر

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

لكن للاسف تجي رساله تم الحذف ولكن لم يتم شي

وانا استعملت and ولكنه ما اشتغل معي ما اعرف السبب

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.

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

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

Important Information