| 在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
|
以下是网友的资料：
哈哈，谢谢，谢谢！ access911.net 我也经常找资料，这个网站真地不错哦！ 我已经基本上明白了这些属性了，并且写了个函数判断输入的用户是否在指定组内： '-----------------------------------------------------------
'该函数用来判断用户是否存在于指定的安全组
'
'当用户属于指定的安全组时，返回 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 帮助中的例子改的，希望大家能有帮助。更希望有高人能帮我把这个函数再优化一下，将不胜感激！！ | 
1702362
