ACC2000: Sample Functions to Check User and Group Information

'********************************************************
' 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