VBA, MS Access MS Access в примерах

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

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

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



'delete old temp table if it exists
    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 = "")
'Отключение всех потключенных таблиц !
'----------------------------------------------------------------------------------------
' es 14.12.2015 - 29.01.2021 v003
' Удаляет из базы все подлинкованные таблицы c sPartOfConnectString
' в строке подключения (свойство .Connect)
' Аргумент:
'   sPartOfConnectString = часть строки подключения типа: ODBC;DRIVER=...
'   Если параметр не указан - удаляются все ПОДКЛЮЧЕННЫЕ ТАБЛИЦЫ
'--------------------------------------------------------------------
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
            'Debug.Print sConnect
            If sPartOfConnectString = "" Or _
                    InStr(sConnect, sPartOfConnectString) > 0 Then
                'db.TableDefs.Delete tdf.Name 'Не надёжно отрабатывает!
                DoCmd.DeleteObject acTable, tdf.Name
                lCount = lCount + 1
            End If
        End If
    Next
    If lCount > 0 Then
        'Обновление Области Навигации (Navigation Pane)
        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, "Произошла ошибка!"
    'Debug.Print "DelAttachedTables_DAO_Line: " & Erl & "."
    Err.Clear
    Resume DelAttachedTables_DAO_End

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. 03.04.2021
Рейтинг@Mail.ru