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



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

Private Sub DelAttachedTables_DAO(Optional sPartOfConnectString As String = "")
' es 12.04.2024 v005
' Удаляет из базы все подлинкованные таблицы или с sPartOfConnectString в строке подключения
' -------------------------------------------------------------------------------------------------/
' Аргумент:
'   sPartOfConnectString = часть строки подключения типа: ODBC;DRIVER=...
'   Если аргумент не указан - удаляются все ПОДКЛЮЧЕННЫЕ ТАБЛИЦЫ
' -------------------------------------------------------------------------------------------------/
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim sConnect$, lCount&, iVal%, blnDelTable As Boolean
On Error GoTo DelAttachedTables_DAO_Err
    
    Set dbs = CurrentDb
    DoCmd.SetWarnings False

    For Each tdf In CurrentDb.TableDefs
        If tdf.Connect <> "" Then
            sConnect = tdf.Connect
            'Debug.Print sConnect
            If Len(sPartOfConnectString) = 0 Then
                blnDelTable = True
            Else
                If InStr(sConnect, sPartOfConnectString) > 0 Then blnDelTable = True
            End If
            If blnDelTable = True Then
                DoCmd.DeleteObject acTable, tdf.Name
                lCount = lCount + 1
            End If
        End If
    Next

    If lCount > 0 Then
        'Обновляем список таблиц тек. базы (не обязательно)
        Application.RefreshDatabaseWindow
        MsgBox "Удаленно " & lCount & " подключенных таблиц.", vbInformation
    Else
        MsgBox "Подключенных таблиц подлежащих удалению не обнаружено.", vbInformation
    End If

DelAttachedTables_DAO_End:
    On Error Resume Next
    DoCmd.SetWarnings True
    Set tdf = Nothing
    dbs.Close: Set dbs = 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. 12.04.2024
Рейтинг@Mail.ru