转自 Access911

在Access中添加用户，定义权限的方法很多，基本有以下几种

DAO方面有：
Group对象
User对象
Permissions属性
AllPermissions属性

ADO(ADOX)方面有：
Catalog对象
User对象
Group对象
SetPermissions方法
GetPermissions方法

Jet SQL(DDL)方面有：
Add User语句
Create Group语句
Create User语句
Drop User语句
Drop Group语句
Alter User语句
Alter Database语句

上述几方面在Access的帮助中都有详细的代码示例以及叙述。


Function Test()
    Debug.Print GetCurrentUserGroups
    Debug.Print GetAllUserGroups
End Function


Function GetCurrentUserGroups()
'请到 Alt + F11 到 VBE 界面下
'菜单 -> 工具 -> 引用
'Microsoft ADO Ext. 2.? for DDL and Security

'本函数获取当前用户所属的用户组的名称

    Dim catDB As New ADOX.Catalog
    Set catDB.ActiveConnection = CurrentProject.Connection
    Dim i As Long
    Dim i1 As Long
    Dim u As ADOX.User
    Dim g As ADOX.Groups
   
    For i = 0 To catDB.Users.Count - 1
        If catDB.Users(i).Name = Application.CurrentUser Then
            Set u = catDB.Users(i)
            For i1 = 0 To u.Groups.Count - 1
                Debug.Print u.Groups(i).Name
                GetCurrentUserGroups = GetCurrentUserGroups & u.Groups(i).Name & ","
            Next
        End If
    Next
End Function


Function GetAllUserGroups()
'请到 Alt + F11 到 VBE 界面下
'菜单 -> 工具 -> 引用
'Microsoft ADO Ext. 2.? for DDL and Security

'本函数获取所有用户所属的用户组的名称

    Dim catDB As New ADOX.Catalog
    Set catDB.ActiveConnection = CurrentProject.Connection
    Dim i As Long
    Dim i1 As Long
    Dim u As ADOX.User
    Dim g As ADOX.Groups
   
    For i = 0 To catDB.Users.Count - 1
        
            Set u = catDB.Users(i)
            GetAllUserGroups = GetAllUserGroups & "UserName:" & u.Name & vbCrLf & Chr(9) & " @ Groups:"
            For i1 = 0 To u.Groups.Count - 1
                Debug.Print u.Groups(i).Name
                GetAllUserGroups = GetAllUserGroups & u.Groups(i).Name & ","
            Next
            GetAllUserGroups = GetAllUserGroups & vbCrLf
    Next
End Function

'===================================

'该函数用来判断用户是否存在于指定的安全组
'
'当用户属于指定的安全组时，返回 True ，否则返回 False
'注：当用户属于“管理员组(Admins)”时，函数始终返回 True
'
'参数：  UsrName  - 指定的用户名（为""时，取当前用户）
'        UsrGroup - 指定的安全组
'-----------------------------------------------------------

Function UserInGroup(UsrName As String, UsrGroup As String) As Boolean

    UserInGroup = False
Dim UsrNameStr As String
    Dim wrkDefault As Workspace
    Dim usrLoop As User
    Dim grpLoop As Group

    If UsrName = "" Then
        UsrNameStr = CurrentUser()
    Else
        UsrNameStr = UsrName
    End If

    Set wrkDefault = DBEngine.Workspaces(0)

    With wrkDefault

        For Each grpLoop In .Groups

            If grpLoop.Users.Count <> 0 Then

                For Each usrLoop In grpLoop.Users

                    If usrLoop.Name = UsrNameStr Then
                        If (grpLoop.Name = UsrGroup) Or (grpLoop.Name = "Admins") Then
                        'If grpLoop.Name = UsrGroup Then
                            'Debug.Print grpLoop.Name
                            UserInGroup = True
                        End If
                    End If

                Next usrLoop

            End If

        Next grpLoop

    End With

End Function

这是根据 MS Access 帮助中的例子改的，希望大家能有帮助。更希望有高人能帮我把这个函数再优化一下，将不胜感激！！