如何获取用户所属的组？

cloudsky

我想根据登陆的用户，判断他是否属于某个工作组，再给他相应的菜单
如何编程实现？请高手赐教
谢谢！

cloudsky

已经解决！与大家一起分享一下，有错误请指教
'/**    function CheckUserInGroup **/
'/**    author:阳荣辉             **/
'   入口参数：UserName
'   出口参数：0-没有所属的组　1－属于Admin组
'           　2-属于组
'   功能：确定用户是否属于某个组，如：admins, users
'此函数需要使用一个管理员权限的用户，此处用的是Guan.zejian，引用时请更改
'语句：Set wk = DBEngine.CreateWorkspace("", "Guan.zejian", "123789")
'                                             ~~~~~~~~~~~user~~~~~~password
'/**********************************/


Function CheckUserInGroup(UserName As String) As Integer
On Error GoTo CheckUserInGroup_Err
   
    Dim wk As DAO.Workspace, Ur As DAO.User, i As Integer, Found As Boolean
    CheckUserInGroup = 0
    Found = False
    Set wk = DBEngine.CreateWorkspace("", "Guan.zejian", "123789")
    '//要特别注意上面一句，必须使用拥有数据库管理权限的用户名和密码打开工作区！
   
    '//下面一段是查找用户名是否存在，不存在出错报告。
     
    For i = 0 To wk.Groups.Count - 1
        If wk.Users(i).Name = UserName Then
            Set Ur = wk.Users(i)
            Found = True
            Exit For
        End If
    Next i
   
    If Not Found Then
        MsgBox "'" & UserName & "' 不是一个有效的用户名！", _
                   vbExclamation, "access"
        CheckUserInGroup = 0
        Exit Function
    End If
   
    '//确认用户是否属于某个组
    For i = 0 To Ur.Groups.Count - 1
        If Ur.Groups(i).Name = "Admins" Then
            CheckUserInGroup = 1
        End If
        
    Next i
   
    'CheckUserInGroup = True
    'Exit Function
CheckUserInGroup_Exit:
    Exit Function
   
CheckUserInGroup_Err:
    MsgBox " create workspace false,please keep user 'guan.zejian' exist and have admin power!", _
                 vbExclamation, "access"
    'MsgBox Err.Description
    CheckUserInGroup = 0
End Function

[此贴子已经被作者于2003-7-30 14:12:54编辑过]

Roadbeg

取得当前用户的组名:
debug.Print  dbengine.Workspaces(0).Users("").Groups(0).Name