Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

如何用VBA检查表有没有设置主键

时 间:2026-05-28 15:35:54
作 者:张志   ID:8  城市:上海  QQ:3059255点击这里给张志发消息
摘 要:在将access文件升迁到SQL SERVER数据库时,先检查一下表有没有设置主键。
正 文:

问:有一个access文件,里面有很多个表,如何用VBA检查哪些表有没有设置主键?如果没有设置则输出表的名称。

答:

  1. 打开你的 Access 文件,按 Alt + F11 进入 VBA 编辑器。

  2. 在菜单中点击 插入 → 模块,将下面的代码粘贴进去。

  3. Ctrl + G 打开“立即窗口”,然后按 F5 运行 CheckTablesWithoutPrimaryKey 过程。

  4. 没有主键的表名会逐行显示在“立即窗口”中。

Sub CheckTablesWithoutPrimaryKey()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim idx As DAO.Index
    Dim hasPK As Boolean
    Dim errOccurred As Boolean
    Dim count As Integer

    Set db = CurrentDb
    count = 0

    For Each tdf In db.TableDefs
        ' 跳过系统表(名称通常以 "MSys" 开头或带有系统属性)
        If (tdf.Attributes And dbSystemObject) = 0 Then
            ' 【可选】如果只想检查本地表,取消下面这行的注释(跳过链接表)
            ' If (tdf.Attributes And dbAttachedTable) = 0 Then
            
            hasPK = False
            errOccurred = False
            
            ' 遍历表中的索引,查找主键
            On Error Resume Next
            For Each idx In tdf.Indexes
                If idx.Primary Then
                    hasPK = True
                    Exit For
                End If
            Next idx
            If Err.Number <> 0 Then
                ' 如果访问索引出错(例如权限问题),记录错误并跳过该表
                Debug.Print "【警告】无法检查表: " & tdf.Name & " (" & Err.Description & ")"
                Err.Clear
                errOccurred = True
            End If
            On Error GoTo 0
            
            ' 未出错且确实没有主键,则输出表名
            If Not errOccurred And Not hasPK Then
                count = count + 1
                Debug.Print "无主键表: " & tdf.Name
            End If
            
            ' End If  ' 对应上面可选排除链接表的 If
        End If
    Next tdf

    If count = 0 Then
        MsgBox "所有表都已设置主键。"
    Else
        MsgBox "发现 " & count & " 个表没有主键,详细列表请查看立即窗口 (Ctrl+G)。"
    End If

    Set idx = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Sub



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助