ACC: Sample Functions to Check User, Group Info

MORE INFORMATION

The Sample Functions

   '********************************************************
   ' Declarations section of the module
   '********************************************************

   Option Compare Database
   Option Explicit

   Function ListUsersInSystem ()
   '****************************************************************
   ' Purpose: Lists users in the current system database.
   ' Accepts: No arguments.
   ' Returns: A list of users in the current system database.
   ' Assumes: The existence of a user called Developer in the Admins
   '          group, with no password.
   '****************************************************************

   On Error GoTo err_ListUsersInSystem

   Dim MyWorkSpace As WorkSpace, i As Integer

   ' Create a new workspace as a member of the Admins group.
   Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   For i = 0 To MyWorkSpace.Users.count - 1
        Debug.Print MyWorkSpace.Users(i).Name
   Next i

   MyWorkSpace.Close
   Exit Function

   err_ListUsersInSystem:
   If Err = 3029 Then
        MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   MyWorkSpace.Close
   Exit Function

   End Function

   Function ListGroupsInSystem ()
   '****************************************************************
   ' Purpose: Lists groups in the current system database.
   ' Accepts: No arguments.
   ' Returns: A list of groups in the current system database.
   ' Assumes: The existence of a user called Developer in the Admins
   '          group, with no password.
   '****************************************************************

   On Error GoTo err_ListGroupsInSystem

   Dim MyWorkSpace As WorkSpace, i As Integer

   ' Create a new workspace as a member of the Admins group.
   Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")
   For i = 0 To MyWorkSpace.Groups.count - 1
        Debug.Print MyWorkSpace.Groups(i).Name
   Next i

   MyWorkSpace.Close

   Exit Function

   err_ListGroupsInSystem:
   If Err = 3029 Then
        MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   MyWorkSpace.Close
   Exit Function

   End Function

   Function ListUsersOfGroup (GroupName As String)
   '****************************************************************
   ' Purpose: Lists users who are members of the specified group in
   '          the current system database.
   ' Accepts: The name of a group.
   ' Returns: A list of users in the specified group.
   ' Assumes: The existence of a user called Developer in the Admins
   '          group, with no password.
   '****************************************************************

   On Error GoTo err_ListUsersOfGroup

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim MyGroup As Group

   ' Create a new workspace as a member of the Admins group.
   Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyGroup = MyWorkSpace.Groups(GroupName)

   For i = 0 To MyGroup.Users.count - 1
        Debug.Print MyGroup.Users(i).Name
   Next i

   MyWorkSpace.Close
   Exit Function

   err_ListUsersOfGroup:
   If Err = 3265 Then
        MsgBox UCase(GroupName) & " isn't a valid group name", 16, "Error"
   ElseIf Err = 3029 Then
        MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   MyWorkSpace.Close
   Exit Function

   End Function

   Function ListGroupsOfUser (UserName As String)
   '****************************************************************
   ' Purpose: Lists the groups to which a specified user belongs.
   ' Accepts: The name of a user.
   ' Returns: A list of groups for the specified user.
   ' Assumes: The existence of a user called Developer in the Admins
   '          group, with no password.
   '****************************************************************

   On Error GoTo err_ListGroupsOfUser

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim MyUser As User

   ' Create a new workspace as a member of the Admins group.
   Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyUser = MyWorkSpace.Users(UserName)

   For i = 0 To MyUser.Groups.count - 1
        Debug.Print MyUser.Groups(i).Name
   Next i

   MyWorkSpace.Close
   Exit Function

   err_ListGroupsOfUser:
   If Err = 3265 Then
        MsgBox UCase(UserName) & " isn't a valid user name", 16, "Error"
   ElseIf Err = 3029 Then
        MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   MyWorkSpace.Close
   Exit Function

   End Function

   Function CurrentUserInGroup (GroupName As String)
   '****************************************************************
   ' Purpose: Determines if the current user belongs to the specified
   '          group.
   ' Accepts: The name of a group.
   ' Returns: True if the current user is a member of the specified
   '          group, False if the current user is not a member of
   '          the group.
   ' Assumes: The existence of a user called Developer in the Admins
   '          group, with no password.
   '****************************************************************

   On Error GoTo err_CurrentUserInGroup

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim MyGroup As Group, MyUser As User

   ' Create a new workspace as a member of the Admins group.
   Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyGroup = MyWorkSpace.Groups(GroupName)
   Set MyUser = MyWorkSpace.Users(CurrentUser())
   For i = 0 To MyGroup.Users.count - 1
        If MyGroup.Users(i).Name = MyUser.Name Then
             CurrentUserInGroup = True
             Exit Function
        End If
   Next i

   CurrentUserInGroup = False
   MyWorkSpace.Close
   Exit Function

   err_CurrentUserInGroup:
   If Err = 3265 Then
        MsgBox UCase(GroupName) & " isn't a valid group name", 16, "Error"
        CurrentUserInGroup = False
   ElseIf Err = 3029 Then
        MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   MyWorkSpace.Close
   Exit Function

   End Function
				

1. Open the sample database Northwind.mdb (or NWIND.MDB in Microsoft Access 2.0).
2. Create a new module and enter the sample functions above.
3. On the View menu, click Debug Window (or Immediate Window in Microsoft Access 2.0.)
4. In the Debug window, type the following line, and then press ENTER:

   ? ListGroupsOfUser("Admin")