访问 VBA 代码以删除表（如果存在）

Question

首先，我必须承认，我没有接受过使用 VBA 编码的培训。我使用 MS Access 宏和查询来构建我的应用程序。我使用了一些临时导入文件，需要运行宏或一些 VBA 来测试它们是否存在，如果存在，则删除它们。

我的表名是“TempImport1”

我通过谷歌搜索对此进行了研究，并遇到了一些可能有效的 VBA，但我在试图弄清楚如何将代码放入模块或单击子按钮时迷失了方向。我过去在一个按钮功能下剪切/粘贴了 VBA 代码，它可以工作，但我不知道为什么这次它不能工作。

老实说，我确信这是我对私有函数和公共函数缺乏了解，当然还有我不了解 VBA 的事实。

这是我正在尝试制作的代码：

Function IsTable(sTblName As String) As Boolean
    'does table exists and work ?
    'note: finding the name in the TableDefs collection is not enough,
    '      since the backend might be invalid or missing

    On Error GoTo TrapError
    Dim x
    x = DCount("*", sTblName)
    IsTable = True
    Exit Function
TrapError:
    Debug.Print Now, sTblName, Err.Number, Err.Description
    IsTable = False

End Function

Answer 1

首先你应该检查表是否存在，然后你应该尝试关闭它，如果它存在。然后您应该将警告设置为 False，这样它就不会询问您是否确定要删除该表。

在下面的示例中，您删除了Table3。 If Not IsNull 正在检查表是否存在：

Option Compare Database
Option Explicit

Public Sub DeleteIfExists()

    Dim tableName As String
    tableName = "Table3"

    If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) Then
        DoCmd.SetWarnings False
        DoCmd.Close acTable, tableName, acSaveYes
        DoCmd.DeleteObject acTable = acDefault, tableName
        Debug.Print "Table" & tableName & "deleted..."
        DoCmd.SetWarnings True
    End If

End Sub

代码应该可以正常工作。

Answer 2

要删除 TempImport1 表（如果存在），只需使用以下函数。

Function DeleteTables()

    If Not IsNull(DLookup("Name", "MSysObjects", "Name='TempImport1' AND Type = 1")) Then
    DoCmd.DeleteObject acTable, "TempImport1"
    End If

End Function

创建函数后，创建一个宏，添加操作运行代码，然后在函数名称中输入DeleteTables()。
然后，您可以运行一个宏来删除该表（如果存在）。

Answer 3

检查MSysObjects（在其他答案中使用）误报了一个表，如果它最近被删除。我发现以下测试更可靠。

Option Compare Database
Option Explicit

Public Sub DeleteIfExists()

    Dim tableName As String
    tableName = "Table3"

    On Error Resume Next
    Set td = db.TableDefs(tableName)
    If Err.Number <> 0 Then
        DoCmd.SetWarnings False
        DoCmd.Close acTable, tableName, acSaveYes
        DoCmd.DeleteObject acTable = acDefault, tableName
        Debug.Print "Table" & tableName & "deleted..."
        DoCmd.SetWarnings True
    End If

End Sub

Answer 4

这是我为摆脱导入错误表而创建的版本。错误。 Number 必须为 0 才能实际删除表。 TRACE 是我的内部标志。

Public Function RemoveImportErrorTables(Optional strTableBaseName As String = "rngExportDaily_ImportErrors") As Integer
'Purpose:
'  Remove ImportError Tables
'In:
'  Tables base Name
'Out:
'  number of tables flushed
'History:
'  Created 2021-12-06 16:10 Anton Sachs; Last modified 2021-12-06 16:15 Anton Sachs
'
  Dim intResult As Integer
  Dim strTableName As String
  Dim dbCur As Database
  Dim tdfTableDef  As TableDef
  Dim intTableIndex As Integer

  On Error GoTo RemoveImportErrorTables_Err
  
  Set dbCur = CurrentDb()
  
  For intTableIndex = 0 To 100
    If intTableIndex = 0 Then
      strTableName = strTableBaseName
    Else
      strTableName = strTableBaseName & CStr(intTableIndex)
    End If
  
    On Error Resume Next
    
    Set tdfTableDef = dbCur.TableDefs(strTableName)
    
    If Err.Number = 0 Then
      DoCmd.SetWarnings False
      DoCmd.Close acTable, strTableName, acSaveYes
      DoCmd.DeleteObject acTable = acDefault, strTableName
      DoCmd.SetWarnings True
      intResult = intResult + 1
    Else
      On Error GoTo RemoveImportErrorTables_Err
      Exit For
    End If
  
  Next intTableIndex

RemoveImportErrorTables_Exit:
  RemoveImportErrorTables = intResult
  If Not tdfTableDef Is Nothing Then
    Set tdfTableDef = Nothing
  End If
  If Not dbCur Is Nothing Then
    Set dbCur = Nothing
  End If
  Exit Function

RemoveImportErrorTables_Err:
  If TRACE = 0 Then TRACE = GetStandard("Trace")

If TRACE <> False Then
  Debug.Print "Error " & Err.Number & " " & Err.Description & " in RemoveImportErrorTables"
  Err.Clear
  If TRACE = CTR±Stop Then
    Stop
    Resume Next
  End If
Else
  Err.Clear
    Resume Next
End If

RemoveImportErrorTables_Fail:
  intResult = False
  GoTo RemoveImportErrorTables_Exit
End Function