sé que con currentUser, puedo evaluar o validar el 
Usuario actual pero alguien sabe como puedo evaluar el 
grupo, por ejemplo si el usuario pertenece al grupo 
Administradores, muestre todo; si pertenece al Grupo Solo 
Lectura, Solo Mueetre una parte de los formularios, etec.


ATRACTOR
========

Algunas funciones mediante ADO,
Ten en cuenta que cambiar un usuario de grupo en la misma sesión no 
cambiara sus privilegios hasta que cierres y vuelvas a iniciar sesión.
Si los quieres mediante DAO avisa
UN SALUDO
----------------------------------------------------------
Public Function EstaUsuarioEnGrupoFE(ByVal NombreUsuario As String, ByVal 
NombreGrupo As String) As Boolean
'Comprueba si el usuario pasado a la función pertenece al grupo
'pasado en la funcion, todo ello en el FrontEnd
    On Error GoTo Error_EstaUsuarioEnGrupoFE
    Dim cat As New ADOX.Catalog
    Dim Gr As ADOX.Group
    Dim Cnn2 As ADODB.Connection
    Set Cnn2 = CurrentProject.Connection
    Set cat.ActiveConnection = Cnn2
    For Each Gr In cat.Users(NombreUsuario).Groups
        If Gr.Name = NombreGrupo Then
            EstaUsuarioEnGrupoFE = True
            GoTo Exit_EstaUsuarioEnGrupoFE
        End If
    Next
Exit_EstaUsuarioEnGrupoFE:
    On Error Resume Next
    Set Gr = Nothing
    Set cat = Nothing
    Cnn2.Close
    Set Cnn2 = Nothing
    Exit Function
Error_EstaUsuarioEnGrupoFE:
    On Error Resume Next
    Set Gr = Nothing
    Set cat = Nothing
    Cnn2.Close
    Set Cnn2 = Nothing
    MsgBox "Error en Función: EstaUsuarioEnGrupoFE", , "Nº Error : " & Err.Number
End Function
------------------------------------------------------------------------
Public Function EstaUsuarioEnGrupoBE(ByVal NombreUsuario As String, ByVal 
NombreGrupo As String) As Boolean
'Comprueba si el usuario pasado a la función pertenece al grupo
'pasado en la funcion, todo ello en el BackEnd
    On Error GoTo Error_EstaUsuarioEnGrupoBE
    Dim cat As New ADOX.Catalog
    Dim Gr As ADOX.Group
    Dim Cnn2 As ADODB.Connection
    ' Aquí puedes ver que los datos de conexion los guardo en propiedades 
    ' de la base de datos.
        Dim strCadenaConexion As String
        strCadenaConexion = "Provider=Microsoft.Jet.OLEDB.4.0; "
        strCadenaConexion = strCadenaConexion & "Data Source = " & CStr(GetDatabaseProp("UltimaRutaBackEnd")) & _
        CStr(GetDatabaseProp("NombreBackEnd")) & ";"
        strCadenaConexion = strCadenaConexion & "Jet OLEDB:System database= " & CStr(GetDatabaseProp("UltimaRutaSystemDatabase")) & _
        CStr(GetDatabaseProp("NombreSystemDatabase"))
        Set Cnn2 = New ADODB.Connection
        Call Cnn2.Open(strCadenaConexion, strAdmin, strPWD)

    
    Set cat.ActiveConnection = Cnn2
    For Each Gr In cat.Users(NombreUsuario).Groups
        If Gr.Name = NombreGrupo Then
            EstaUsuarioEnGrupoBE = True
            GoTo Exit_EstaUsuarioEnGrupoBE
        End If
    Next
Exit_EstaUsuarioEnGrupoBE:
    On Error Resume Next
    Set Gr = Nothing
    Set cat = Nothing
    Cnn2.Close
    Set Cnn2 = Nothing
    Exit Function
Error_EstaUsuarioEnGrupoBE:
    On Error Resume Next
    Set Gr = Nothing
    Set cat = Nothing
    Cnn2.Close
    Set Cnn2 = Nothing
    MsgBox "Error en Función: basGenerales.EstaUsuarioEnGrupoBE", , "Nº Error : " & Err.Number
End Function
--------------------------------------------
Public Sub AsignaUsuarioAGrupo(usrName As String, grpName As String)
    On Error GoTo ADDTRAP
    Dim cat1 As ADOX.Catalog
    'Instancia el catalogo
    Set cat1 = New ADOX.Catalog
    'Establece la propiedad activeconnection del catálogo para
    'utilizarlo al añadir un nuevo a grupo a  un usuario existente.
        Dim str As String
        str = "Provider=Microsoft.Jet.OLEDB.4.0; "
        str = str & "Data Source = "
        str = str & CurrentProject.FullName & ";"
        str = str & "Jet OLEDB:System database= "
        str = str & CStr(GetDatabaseProp("UltimaRutaSystemDatabase"))
        str = str & CStr(GetDatabaseProp("NombreSystemDatabase")) & ";"
        str = str & "User Id = UAdmin; PassWord =" & strPWD & ";"

        cat1.ActiveConnection = str
        
        cat1.Users(usrName).Groups.Append grpName
        cat1.Users(usrName).Groups.Refresh
        

ADDEXIT:
    Set cat1 = Nothing
Exit Sub

ADDTRAP:
    MsgBox "Error al asignar el usuario a un grupo", , Err.Number
    GoTo ADDEXIT
End Sub
----------------------------------------------------------------------
Public Sub RemueveUsuarioDeGrupo(usrName As String, grpName As String)
    On Error GoTo ADDTRAP
    Dim cat1 As ADOX.Catalog
    'Instancia el catalogo
    Set cat1 = New ADOX.Catalog
    'Establece la propiedad activeconnection del catálogo para
    'utilizarlo al añadir un nuevo a grupo a  un usuario existente.
        Dim str As String
        str = "Provider=Microsoft.Jet.OLEDB.4.0; "
        str = str & "Data Source = "
        str = str & CurrentProject.FullName & ";"
        str = str & "Jet OLEDB:System database= "
        str = str & CStr(GetDatabaseProp("UltimaRutaSystemDatabase"))
        str = str & CStr(GetDatabaseProp("NombreSystemDatabase")) & ";"
        str = str & "User Id = UAdmin; PassWord = " & strPWD & ";"

        cat1.ActiveConnection = str
        
        cat1.Users(usrName).Groups.Delete grpName
        cat1.Users(usrName).Groups.Refresh


ADDEXIT:
    Set cat1 = Nothing
Exit Sub

ADDTRAP:
    MsgBox "Error al desasignar el usuario a un grupo", , Err.Number
    GoTo ADDEXIT
   
End Sub