Удаление всех подключенных таблиц (DAO)
Простое удаление таблицы
DoCmd.DeleteObject acTable, "MyTableName"
CurrentDb.TableDefs.Delete "MyTableName"
If Nz(DCount("[Name]", "MSysObjects", "[Name]='tblTEMP_Cross'"), 0) <> 0 Then
DoCmd.DeleteObject acTable, "tblTEMP_Cross"
End If
Удаление всех подлинкованных таблиц (или выборочно по строке подключения)
Public Sub DelAttachedTables_DAO(Optional sPartOfConnectString As String = "")
On Error GoTo DelAttachedTables_DAO_Err
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim sConnect$, lCount&
DoCmd.SetWarnings False
Set db = CurrentDb()
For Each tdf In db.TableDefs
If tdf.Connect <> "" Then
sConnect = tdf.Connect
If sPartOfConnectString = "" Or _
InStr(sConnect, sPartOfConnectString) > 0 Then
DoCmd.DeleteObject acTable, tdf.Name
lCount = lCount + 1
End If
End If
Next
If lCount > 0 Then
CurrentDb.TableDefs.Refresh
Application.RefreshDatabaseWindow
DoEvents
End If
DelAttachedTables_DAO_End:
On Error Resume Next
DoCmd.SetWarnings True
Set tdf = Nothing
db.Close
Set db = Nothing
Err.Clear
Exit Sub
DelAttachedTables_DAO_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
"DelAttachedTables_DAO - modConnection_DAO.", vbCritical, "Произошла ошибка!"
Err.Clear
Resume DelAttachedTables_DAO_End
End Sub
Удаление всех таблиц (кроме системных)
Private Sub DelAllTables()
Dim tdf As TableDef
On Error GoTo DelAllTablesErr
For Each tdf In CurrentDb.TableDefs
If (tdf.Attributes And dbSystemObject) = False Then
CurrentDb.TableDefs.Delete tdf.Name
End If
Next
CurrentDb.TableDefs.Refresh
DelAllTablesBye:
Exit Sub
DelAllTablesErr:
MsgBox "Произошла ошибка при удалении таблиц:" & vbCrLf & _
Err.Description, vbCritical
Resume DelAllTablesBye
End Sub
|