Newsgroup: it.comp.appl.access
Titolo: InGroup(user,group) ??

Per rendere più flessibile la mia applicazione mi farebbe comodo
sapere se l'utente corrente appartiene ad un determinato gruppo
del mio workgroup.
Vorrei realizzare qualcosa del genere:
If InGroup(CurrentUser( ),"Contabilità")  Then
   ...
Ho cercato sulle FAQ ma non mi pare ci sia niente..
Grazie in anticipo.
Giuliano

 Giuliano
Ecco qua:
Const adhcErrNameNotInCollection = 3265
Const adhcErrNoPermission = 3033
Const adhcErrBadAccntOrPwd = 3029
Public Function adhIsGroupMember(ByVal strGroup As String, _
 Optional ByVal varUser As Variant) As Boolean
    ' Verifies if a user is a member of a group.
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert. (Sybex)
    ' Copyright 1997. All Rights Reserved.
    ' In:
    '    strGroup: name of group
    '    strUser: optional name of user;
    '      if missing, current user is used
    ' Out:
    '    Return Value: True if user is member; False if not
    ' Example:
    '    fOK = adhIsGroupMember("Pets", "Kizzie")
    On Error GoTo adhIsGroupMemberErr
    Dim wrk As Workspace
    Dim usr As User
    Dim grp As Group
    Dim strMsg As String
    Dim intErrHndlrFlag As Integer
    Dim varGroupName As Variant
    Const adhcFlagSetUser = 1
    Const adhcFlagSetGroup = 2
    Const adhcFlagCheckMember = 4
    Const adhcFlagElse = 0
    Const adhcProcName = "adhIsGroupMember"
    adhIsGroupMember = False
    'Initialize flag for determining
    'context for error handler
    intErrHndlrFlag = adhcFlagElse
 
    Set wrk = DBEngine.Workspaces(0)
    'Refresh users and groups collections
    wrk.Users.Refresh
    wrk.Groups.Refresh
 
    If IsMissing(varUser) Then varUser = CurrentUser()
    intErrHndlrFlag = adhcFlagSetUser
    Set usr = wrk.Users(varUser)
    intErrHndlrFlag = adhcFlagSetGroup
    Set grp = wrk.Groups(strGroup)
    intErrHndlrFlag = adhcFlagCheckMember
    varGroupName = usr.Groups(strGroup).Name
    If Not IsEmpty(varGroupName) Then
        adhIsGroupMember = True
    End If
adhIsGroupMemberDone:
    On Error GoTo 0
    Exit Function
adhIsGroupMemberErr:
    Select Case Err
    Case adhcErrNameNotInCollection
        Select Case intErrHndlrFlag
        Case adhcFlagSetUser
            strMsg = "The user account '" & varUser & _
             "' doesn't exist."
        Case adhcFlagSetGroup
            strMsg = "The group account '" & strGroup & _
             "' doesn't exist."
        Case adhcFlagCheckMember
            Resume Next
        Case Else
            strMsg = "Error " & Err.Number & ": " & _
             Err.Description
        End Select
    Case adhcErrNoPermission
        strMsg = "You don't have permission to perform " & _
         "this operation."
    Case Else
        strMsg = "Error " & Err.Number & ": " & Err.Description
    End Select
        MsgBox strMsg, vbCritical + vbOKOnly, "Procedure " & _
         adhcProcName
    Resume adhIsGroupMemberDone
End Function
-- 
Federico
--------------------------------------
Sito Comune di it.comp.appl.access
http://members.xoom.it/it_db_access
mailto:
it_db_...@usa.net
--------------------------------------
Tutte le richieste che mi arrivano
in privato, vengono cestinate.
--------------------------------------
Rimuovi paperino. per e-mail
--------------------------------------