در مرحله اول کدهای زیر را در یک ماژول کیی کنید
Option Compare Database
Public Function StopManualTableDelete(YesOrNo As String)
Dim fld As DAO.Field
Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim SQL_CreateConstraint As String, SQL_DropConstraint As String
Dim strConstraint As String ' this variable holds the name of the constraint
Dim i As Integer
Dim tblNames As String, DeleteInfo As String
Set db = CurrentDb()
i = 0
For Each tbl In db.TableDefs
' Bypass system tables with autonumbers
' Also any hidden table that starts with "~"
If Mid(tbl.Name, 1, 4) <> "MSys" Then
If Left(tbl.Name, 1) <> "~" Then
For Each fld In db.TableDefs(tbl.Name).Fields
If dbAutoIncrField = (fld.Attributes And dbAutoIncrField) Then 'Find autonumber
DoCmd.Hourglass True
strConstraint = "con_" & fld.Name & "_" & tbl.Name 'Build constraint name
If YesOrNo = "YES" Then
i = i + 1
'Drop any existing autonumber field constraints if there is one.
If FindCheckConstraint(strConstraint) = True Then
SQL_DropConstraint = "ALTER TABLE " & tbl.Name & _
" DROP CONSTRAINT " & strConstraint
CurrentProject.Connection.Execute SQL_DropConstraint
End If
DoEvents ' await a while just in case
'create the new constraint to disallow the table from being deleted.
SQL_CreateConstraint = " ALTER TABLE " & tbl.Name & " ADD " & _
" CONSTRAINT " & strConstraint & _
" CHECK (" & fld.Name & " IS NOT NULL))"
'Debug.Print SQL_CreateConstraint
CurrentProject.Connection.Execute SQL_CreateConstraint
DeleteInfo = "äãí ÊæÇäíÏ"
End If
If YesOrNo = "NO" Then
'Drop any existing autonumber field constraints.
If FindCheckConstraint(strConstraint) = True Then
i = i + 1
SQL_DropConstraint = "ALTER TABLE " & tbl.Name & _
" DROP CONSTRAINT " & strConstraint
CurrentProject.Connection.Execute SQL_DropConstraint
DeleteInfo = "ãí ÊæÇäíÏ"
End If
End If
tblNames = tblNames & tbl.Name & vbNewLine
Exit For
End If
Next fld
End If
End If
Next tbl
db.Close
Set db = Nothing
DoCmd.Hourglass False
If i > 0 Then
MsgBox i & " ÊäÙíãÇÊ ÑÇ ÈÕæÑÊí ÇäÌÇã ÏÇÏå ÇíÏ ˜å " & DeleteInfo & " ÌÏÇæá ÑÇÈÕæÑÊ ÏÓÊí ÍÐÝ ˜äíÏ æ ÊÚÏÇÏÔÇä" _
& vbNewLine & ": ãæÑÏãí ÈÇÔÏ. Çíä ÌÏÇæá ÔÇãá" & vbNewLine & vbNewLine & tblNames
Else
MsgBox "There are no tables with Autonumber fields present in this database." _
& vbNewLine & "Therefore this code did not have any effect on this database."
End If
End Function
''''''''''''''''''''''''''''''
Public Function FindCheckConstraint(MyConstraint As String) As Boolean
'this function checks to see if a check constraint already exist on the autonumber field.
Dim fld As ADODB.Field
Dim rst As ADODB.Recordset
Set rst = CurrentProject.Connection.OpenSchema(adSchemaCheck Constraints)
Do Until rst.EOF
For Each fld In rst.Fields
If fld.Name = "CONSTRAINT_NAME" Then
If fld.Value = MyConstraint Then
'Debug.Print fld.Value
FindCheckConstraint = True
Exit For
End If
End If
Next fld
rst.MoveNext
Loop
End Function
'StopManualTableDelete("Yes") ÈÇ ÇäÊÎÇÈ Çíä Òíäå Úãá ÍÐÝ ÇäÌÇã äãíÔæÏ
'StopManualTableDelete("NO") ÈÇ ÇäÊÎÇÈ Çíä Òíäå Úãá ÍÐÝ ÇäÌÇã ãíÔæÏ
در مرحله دوم در نمای ماژول کلید Ctl+G را همزمان فشرده تا قسمت Immediate نمایش داده شود سپس کد زیر را در آنجا کپی کرده و دکمه Enter برنید
StopManualTableDelete("Yes")
حالت yes باعث عدم حذف جداول و حالت No باعث حذف جداول میشود.
میتوانید فقط بجای Yes _ کلمه No بنویسید
هربار که جدول جدید ایجاد می کنید برای عدم حذف میبایست مرحله دوم را مجدداً تکرار کنید
موفق باشید
پاسخ با نقل قول
