TopPicLogo TopPicText

Удаление Таблиц

Простое удаление таблицы

   DoCmd.DeleteObject acTable, "MyTableName" 
'--------------------------------------------------------------------
'Или так... 
   CurrentDb.TableDefs.Delete "MyTableName"



Удаление всех подлинкованных таблиц (или выборочно по строке подключения)

Public Sub DelConnectedTables(Optional strStartOfConnectString As String = "")
' es 14.12.2015
' Удаляет из базы все подлинкованные таблицы c strStartOfConnectString
' в начале строки подключения (свойство .Connect)
' Аргумент:
'   strStartOfConnectString = начало строки подключения типа: ODBC;DRIVER=...
'   Если параметр не указан - удаляются все ПОДКЛЮЧЕННЫЕ ТАБЛИЦЫ
'--------------------------------------------------------------------
Dim tbl As TableDef
Dim i As Integer
On Error GoTo DelConnectedTablesErr
    i = Len(strStartOfConnectString) 'длинна префикса
    Select Case i
        Case Is > 0 ' удаление по строке подключения
            
            For Each tbl In CurrentDb.TableDefs
                If Mid(tbl.Connect, 1, i) = strStartOfConnectString Then
                    CurrentDb.TableDefs.Delete tbl.Name
                End If
            Next
            
        Case Else ' удаление всех подключенных
            For Each tbl In CurrentDb.TableDefs
                If tbl.Connect <> "" Then
                    CurrentDb.TableDefs.Delete tbl.Name
                End If
            Next
    End Select
    
    DoEvents
    CurrentDb.TableDefs.Refresh
    
DelConnectedTablesBye:
    Exit Sub

DelConnectedTablesErr:
    MsgBox "Произошла ошибка при удалении подключенных таблиц:" & vbCrLf & _
    Err.Description, vbCritical
    Resume DelConnectedTablesBye
End Sub

Удаление всех таблиц (кроме системных)

Private Sub DelAllTables()
'es 20.01.04
'Удаляет из базы ВСЕ! таблицы (кроме системных)
'--------------------------------------------------------------------
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

Назад ToTop
L.E. 23.05.2016
Рейтинг@Mail.ru