从Excel VBA-检查Access表是否存在/如果不存在,则创建/复制

从Excel VBA-检查Access表是否存在/如果不存在,则创建/复制,excel,vba,ms-access,Excel,Vba,Ms Access,我正在通过Excel使用VBA中的Access数据库。我想检查数据库中是否存在表,如果不存在,我想使用与该数据库中标记为“Blank”的表相同的字段/定义创建表。如果需要,我可以简单地复制/重命名Blank 我找到了一种使用以下方法检查表是否存在的方法(但不确定这是否是最好的方法) 这是可行的,但当目标表不存在时(tbExists=False),我正在努力找到一种方法,使用Blank的字段/定义复制或创建一个新表。这可能是另一种通过检查表定义是否返回任何内容来检查表是否存在的方法 TableDe

我正在通过Excel使用VBA中的Access数据库。我想检查数据库中是否存在表,如果不存在,我想使用与该数据库中标记为“Blank”的表相同的字段/定义创建表。如果需要,我可以简单地复制/重命名Blank

我找到了一种使用以下方法检查表是否存在的方法(但不确定这是否是最好的方法)


这是可行的,但当目标表不存在时(tbExists=False),我正在努力找到一种方法,使用Blank的字段/定义复制或创建一个新表。

这可能是另一种通过检查表定义是否返回任何内容来检查表是否存在的方法

TableDef对象表示存储的基表或链接表的定义(仅限Microsoft Access工作空间)

更多信息

这对我很有效:

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\June\Umpires.accdb"
cn.Execute "SELECT Blank.* INTO [" & tbName & "] FROM Blank"
cn.Close
Set cn = Nothing
如果不执行其他操作,例如压缩和修复或关闭/重新打开数据库,或运行在导航窗格中选择表的代码,或以某种方式刷新窗格(隐藏/取消隐藏窗格会这样做),新表将不会实际显示在导航窗格中

某些字段属性设置将不会继续(AllowZeroLength=No)。计算类型字段和多值字段将导致运行时错误


DoCmd.CopyObject和DoCmd.TransferDatabase可以精确复制表。重命名可以简单地重命名表。所有这些都需要声明和打开Access数据库对象变量的代码。

从excel vba创建Access对象

Sub TableExistOrCreate()

    Dim appAccess As Object, tbl As Object
    Set appAccess = CreateObject("Access.Application")

    appAccess.OpenCurrentDatabase ("C:\Users\santosh\Desktop\test.accdb")

    On Error Resume Next
    Set tbl = appAccess.currentdata.AllTables("Test")
    On Error GoTo 0

    If tbl Is Nothing Then
        appAccess.docmd.CopyObject , "Test", 0, "Blank"
    End If

    Set appAccess = Nothing

End Sub

很高兴知道,但并没有真正解决“努力找到复制或创建新表的方法”的问题。谢谢大家的帮助。显然,我的整个DB设计方法都有缺陷,所以这个问题没有意义,但我非常感谢您的帮助!
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\June\Umpires.accdb"
cn.Execute "SELECT Blank.* INTO [" & tbName & "] FROM Blank"
cn.Close
Set cn = Nothing
Sub TableExistOrCreate()

    Dim appAccess As Object, tbl As Object
    Set appAccess = CreateObject("Access.Application")

    appAccess.OpenCurrentDatabase ("C:\Users\santosh\Desktop\test.accdb")

    On Error Resume Next
    Set tbl = appAccess.currentdata.AllTables("Test")
    On Error GoTo 0

    If tbl Is Nothing Then
        appAccess.docmd.CopyObject , "Test", 0, "Blank"
    End If

    Set appAccess = Nothing

End Sub