This module contains procedures for working with the Microsoft Jet User-Level Security model in term

' Module   : modJetSecurity
' Description : Code for working with Jet security
' Source   : JustACoder
'
' Enumerated type to identify database object types
Public Enum EnumSecJetObjectType
 sjotTable = 0
 sjotQuery = 1
 sjotRelation = 6
 sjotAccessForm = 2
 sjotAccessReport = 3
 sjotAccessMacro = 4
 sjotAccessModule = 5
End Enum
Public Function AddGroup( _
 strWorkspace As String, _
 strGroup As String, _
 strPID As String) _
 As Boolean
 ' Comments : Adds the named group to the named workgroup
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '       strGroup - Name of the group to add
 '       strPID - Personal identifier (PID) for the new group
 ' Returns  : True if successful, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim grpTmp As DAO.Group
 Dim fOK As Boolean
 
 On Error GoTo PROC_ERR
 
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Create the group with the values specified
 Set grpTmp = wrkTmp.CreateGroup(strGroup, strPID)
 
 ' Append the new group to make it a permanent part of the workgroup
 wrkTmp.Groups.Append grpTmp
 fOK = True
 
PROC_EXIT:
 AddGroup = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "AddGroup"
 Resume PROC_EXIT
End Function
Public Function AddUser( _
 strWorkspace As String, _
 strUser As String, _
 strGroup As String, _
 strPID As String) _
 As Boolean
 ' Comments : Adds a new user
 ' Parameters: strWorkspace - Name of the workspace to use or
 '       "" (blank string) for Workspaces(0)
 '       strUser - Name of the user to add
 '       strGroup - Name of the group to add the new user to
 '       strPID - Personal identifier (PID) for the new user
 ' Returns  : True if successful, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim usrTmp As DAO.User
 Dim fOK As Boolean
 
 On Error GoTo PROC_ERR
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Create the user
 Set usrTmp = wrkTmp.CreateUser(strUser, strPID)
 
 ' Append the user to make it permanent
 wrkTmp.Users.Append usrTmp
 ' Add the user to the specified group
 usrTmp.Groups.Append usrTmp.CreateGroup(strGroup)
 fOK = True
PROC_EXIT:
 AddUser = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "AddUser"
 Resume PROC_EXIT
End Function
Public Function AddUserToGroup( _
 strWorkspace As String, _
 strUser As String, _
 strGroup As String) _
 As Boolean
 ' Comments : Adds an existing user to an existing group
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '      : strUser - Name of the user
 '       strGroup - Name of the group to add the new user to
 ' Returns  : True if successful, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim usrTmp As DAO.User
 Dim fOK As Boolean
 
 On Error GoTo PROC_ERR
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 
 ' Get a handle to the user
 Set usrTmp = wrkTmp.Users(strUser)
 ' Add the user to the specified group
 usrTmp.Groups.Append usrTmp.CreateGroup(strGroup)
 fOK = True
PROC_EXIT:
 AddUserToGroup = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "AddUserToGroup"
 Resume PROC_EXIT
End Function
Public Function CanUserCreateObject( _
 strWorkspace As String, _
 strDatabase As String, _
 strUser As String, _
 eObjType As EnumSecJetObjectType) _
 As Boolean
 ' Comments : Determines if the named user can create an object of the
 '       specified type
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '       strDatabase - Name of the database to check in
 '       strUser - Name of the user to check
 '       eObjType - Type of object as defined by the
 '       EnumSecJetObjectType enumerated type
 ' Returns  : True if user can create object, False otherwise
 ' Source  : JustACoder
 '
 Dim dbsTmp As DAO.Database
 Dim wrkTmp As DAO.Workspace
 Dim conTmp As DAO.Container
 On Error GoTo PROC_ERR
 ' Open the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Open the database
 Set dbsTmp = wrkTmp.OpenDatabase(strDatabase)
 ' Get a pointer to the appropriate container
 Select Case eObjType
  Case sjotTable, sjotQuery
   Set conTmp = dbsTmp.Containers("Tables")
  Case sjotAccessForm
   Set conTmp = dbsTmp.Containers("Forms")
  Case sjotAccessReport
   Set conTmp = dbsTmp.Containers("Reports")
  Case sjotAccessMacro
   Set conTmp = dbsTmp.Containers("Scripts")
  Case sjotAccessModule
   Set conTmp = dbsTmp.Containers("Modules")
 End Select
 ' Associate the user with the container
 conTmp.UserName = strUser
 
 ' Check the permissions
 If (conTmp.Permissions And DAO.dbSecCreate) = DAO.dbSecCreate Then
  CanUserCreateObject = True
 Else
  CanUserCreateObject = False
 End If
 ' Close the database
 dbsTmp.Close
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "CanUserCreateObject"
 Resume PROC_EXIT
 
End Function
Public Function ChangeUserPassword( _
 strWorkspace As String, _
 strUser As String, _
 strOldPass As String, _
 strNewPass As String) _
 As Boolean
 ' Comments : Changes the named user's password
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '       strUser - Name of the user
 '       strOldPass - User's current password
 '       strNewPass - User's new password
 ' Returns  : True if password was changed, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim usrTmp As DAO.User
 Dim fOK As Boolean
 
 On Error GoTo PROC_ERR
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Get a handle to the user
 Set usrTmp = wrkTmp.Users(strUser)
 
 ' Change the password with the NewPassword method
 usrTmp.NewPassword strOldPass, strNewPass
 fOK = True
PROC_EXIT:
 ChangeUserPassword = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "ChangeUserPassword"
 Resume PROC_EXIT
End Function
Public Function DropGroup( _
 strWorkspace As String, _
 strGroup As String) _
 As Boolean
 ' Comments : Deletes the named group from the workgroup
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '      : strGroup - Name of the group to delete
 ' Returns  : True if successful, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim fOK As Boolean
  
 On Error GoTo PROC_ERR
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 
 ' Delete the user
 wrkTmp.Groups.Delete strGroup
 fOK = True
            
PROC_EXIT:
 DropGroup = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "DropGroup"
 Resume PROC_EXIT
            
End Function
Public Function DropUser( _
 strWorkspace As String, _
 strUser As String) _
 As Boolean
 ' Comments : Deletes the named user from the workgroup
 ' Parameters: strWorkspace - name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '      : strUser - name of the user to delete
 ' Returns  : True if successful, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim fOK As Boolean
 
 On Error GoTo PROC_ERR
 ' Assume failure
 fOK = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 
 ' Delete the user
 wrkTmp.Users.Delete strUser
 fOK = True
            
PROC_EXIT:
 DropUser = fOK
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "DropUser"
 Resume PROC_EXIT
End Function
Public Function GetOwner( _
 strWorkspace As String, _
 strDatabase As String, _
 eType As EnumSecJetObjectType, _
 strName As String) _
 As String
 ' Comments : Returns the owner of the specified object
 ' Parameters: strWorkspace - Name of the workspace or "" (blank string)
 '       to use the current (0) workgroup
 '       strDatabase - Path and name of the database that contains the
 '       object to check
 '       eType - Type of object as defined by the
 '       EnumSecJetObjectType enumerated type
 '       strName - Name of the object
 ' Returns  : String owner of object, or blank string if error
 ' Source  : JustACoder
 '
 Dim dbsTmp As DAO.Database
 Dim conTmp As DAO.Container
 Dim wrkTmp As DAO.Workspace
 Dim strReturn As String
 
 On Error GoTo PROC_ERR
 
 ' Assume failure
 strReturn = ""
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 
 ' Open the database
 Set dbsTmp = wrkTmp.OpenDatabase(strDatabase)
 
 ' Get a handle to the appropriate container
 Select Case eType
  Case sjotTable, sjotQuery
   Set conTmp = dbsTmp.Containers("Tables")
  Case sjotAccessForm
   Set conTmp = dbsTmp.Containers("Forms")
  Case sjotAccessReport
   Set conTmp = dbsTmp.Containers("Reports")
  Case sjotAccessMacro
   Set conTmp = dbsTmp.Containers("Scripts")
  Case sjotAccessModule
   Set conTmp = dbsTmp.Containers("Modules")
 End Select
 ' Get the owner
 strReturn = conTmp.Documents(strName).Owner
             
 ' Close the database
 dbsTmp.Close
PROC_EXIT:
 GetOwner = strReturn
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "GetOwner"
 Resume PROC_EXIT
End Function
Public Function GroupExists( _
 strWorkspace As String, _
 strGroup As String) _
 As Boolean
 ' Comments : Determines if the named group exists
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '      : strGroup - Name of the group to check
 ' Returns  : True if group exists, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim varTmp As Variant
 Dim lngSaveErr As Long
 Dim fGroup As Boolean
 
 On Error GoTo PROC_ERR
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 
 ' Turn off error handling and try to access the group
 On Error Resume Next
 varTmp = wrkTmp.Groups(strGroup).Name
 lngSaveErr = Err.Number
 On Error GoTo PROC_ERR
 
 fGroup = (lngSaveErr = 0)
 
PROC_EXIT:
 GroupExists = fGroup
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "GroupExists"
 Resume PROC_EXIT
End Function
Public Function GroupsToArray( _
 strWorkspace As String, _
 astrIn() As String) _
 As Integer
 ' Comments : Populates the passed array with a list of groups
 ' Parameters: strWorkspace - name of the workspace to check
 '       or "" (blank string) for Workspaces(0)
 '       astrIn - array of strings (0-based)
 ' Returns  : number of groups
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim intCount As Integer
 Dim intCounter As Integer
 
 On Error GoTo PROC_ERR
 ' get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Get the count of groups and resize the array accordingly
 intCount = wrkTmp.Groups.Count
 ReDim astrIn(0 To intCount - 1)
 ' Add the groups to the array
 For intCounter = 0 To intCount - 1
  astrIn(intCounter) = wrkTmp.Groups(intCounter).Name
 Next intCounter
 
 ' Return the count
 GroupsToArray = intCount
 
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "GroupsToArray"
 Resume PROC_EXIT
 
End Function
Public Function GroupsToString( _
 strWorkspace As String, _
 strIn As String, _
 chrDelimit As String) _
 As Integer
 ' Comments : Populates the passed string with a list of groups
 ' Parameters: strWorkspace - name of the workspace to check
 '       or "" (blank string) for Workspaces(0)
 '       strIn - string to populate
 '       chrDelimit - character to delimit groups within string
 ' Returns  : number of groups
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim intCount As Integer
 Dim intCounter As Integer
 
 On Error GoTo PROC_ERR
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Get the number of groups so we know when to stop
 intCount = wrkTmp.Groups.Count
 
 ' Append each group name to the string
 For intCounter = 0 To intCount - 1
  strIn = strIn & wrkTmp.Groups(intCounter).Name
  ' If we aren't on the last one, append the delimiter
  If intCounter < intCount - 1 Then
   strIn = strIn & chrDelimit
  End If
 Next intCounter
 ' Return the count
 GroupsToString = intCount
 
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "GroupsToString"
 Resume PROC_EXIT
End Function
Public Function IsUserMemberOfAdmins( _
 strWorkspace As String, _
 strUser As String) _
 As Boolean
 ' Comments : Determines if the named user is a member of the admins group
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '      : strUser - Name of the user to check
 ' Returns  : True-user is a member of admins, False otherwise
 ' Source  : JustACoder
 '
 Dim varTmp As Variant
 Dim wrkTmp As DAO.Workspace
 Dim lngSaveErr As Long
 Dim fMember As Boolean
 
 On Error GoTo PROC_ERR
 
 ' Assume failure
 fMember = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Turn off error handling and attempt to access the user
 ' as a member of the Admins group. If an error occurs,
 ' the user isn't a member
 On Error Resume Next
 varTmp = wrkTmp.Users(strUser).Groups("Admins").Name
 lngSaveErr = Err.Number
 On Error GoTo PROC_ERR
 
 fMember = (lngSaveErr = 0)
 
PROC_EXIT:
 IsUserMemberOfAdmins = fMember
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "IsUserMemberOfAdmins"
 Resume PROC_EXIT
End Function
Public Function IsUserMemberOfGroup( _
 strWorkspace As String, _
 strUser As String, _
 strGroup As String) _
 As Boolean
 ' Comments : Determines if the named user is a member of the
 '       specified group
 ' Parameters: strWorkspace - name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '       strUser - name of the user to check
 '       strGroup - group to check membership in'
 ' Returns  : True-user is a member of group, false otherwise
 ' Source  : JustACoder
 '
 Dim varTmp As Variant
 Dim wrkTmp As DAO.Workspace
 Dim lngSaveErr As Long
 Dim fUser As Boolean
  
 On Error GoTo PROC_ERR
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Turn off error handling and try to access the user as
 ' as member of the specified group. If an error occurs,
 ' the user isn't a member of the group.
 On Error Resume Next
 varTmp = wrkTmp.Users(strUser).Groups(strGroup).Name
 lngSaveErr = Err.Number
 On Error GoTo PROC_ERR
 
 fUser = (lngSaveErr = 0)
 IsUserMemberOfGroup = fUser
 
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "IsUserMemberOfGroup"
 Resume PROC_EXIT
 
End Function
Public Function UserHasPassword( _
 strWorkspace As String, _
 strUser As String) _
 As Boolean
 ' Comments : Determines if the named user has a password set
 ' Parameters: strWorkspace - Name of the workspace to use or
 '       "" (blank string) for Workspaces(0)
 '       strUser - Name of the user
 ' Returns  : True if user has a password set, False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim usrTmp As User
 Dim lngSaveErr As Long
 Dim fPassword As Boolean
 
 On Error GoTo PROC_ERR
 
 ' Assume failure
 fPassword = False
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 Set usrTmp = wrkTmp.Users(strUser)
 ' disable error handling
 On Error Resume Next
 ' Attempt to set a blank password
 usrTmp.NewPassword "", ""
 lngSaveErr = Err.Number
 On Error GoTo PROC_ERR
 
 Select Case lngSaveErr
  Case 0
   ' No error, so the user doesn't have a password
   fPassword = False
   
  Case 3033:
   ' Error occurred, so the user does have a password
   fPassword = True
  Case Else
   ' Unanticipated error - assume user has no password set
   fPassword = False
   
 End Select
PROC_EXIT:
 UserHasPassword = fPassword
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "UserHasPassword"
 Resume PROC_EXIT
  
End Function
Public Function UserHasPermission( _
 strWorkspace As String, _
 strUser As String, _
 strDatabase As String, _
 strName As String, _
 eType As EnumSecJetObjectType, _
 lngPerms As Long) _
 As Boolean
 ' Comments : Determines if the specified user has explicit
 '       permissions to the specified object
 ' Parameters: strWorkspace - Name of the workspace to use
 '       or "" (blank string) for Workspaces(0)
 '       strUser - Name of the user
 '       strDatabase - Path and name of the database that
 '       contains the object to be tested
 '       strName - Name of the object to check
 '       eType - Type of object as defined by the
 '       EnumSecJetObjectType enumerated type
 '       lngPerms - Permissions constant to check
 '       (i.e. dbSecWriteDef-search DAO online help under
 '       Permissions' for all available settings.)
 ' Returns  : True if the user has the specified permission,
 '       False otherwise
 ' Source  : JustACoder
 '
 Dim wrkTmp As DAO.Workspace
 Dim dbsTmp As DAO.Database
 Dim conTmp As DAO.Container
 Dim usrTmp As DAO.User
 Dim fPerm As Boolean
 
 On Error GoTo PROC_ERR
 ' Assume failure/no permisions
 fPerm = False
 
 ' Open the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Open the database
 Set dbsTmp = wrkTmp.OpenDatabase(strDatabase)
 
 ' Get the user
 Set usrTmp = wrkTmp.Users(strUser)
 ' Set the appropriate container
 Select Case eType
  Case sjotTable, sjotQuery
   Set conTmp = dbsTmp.Containers("Tables")
  Case sjotAccessForm
   Set conTmp = dbsTmp.Containers("Forms")
  Case sjotAccessReport
   Set conTmp = dbsTmp.Containers("Reports")
  Case sjotAccessMacro
   Set conTmp = dbsTmp.Containers("Scripts")
  Case sjotAccessModule
   Set conTmp = dbsTmp.Containers("Modules")
 End Select
 
 ' Set the container's user
 conTmp.UserName = strUser
 ' Check the permissions
 fPerm = ((conTmp.Documents(strName).Permissions And lngPerms) = lngPerms)
 ' Close the database
 dbsTmp.Close
PROC_EXIT:
 UserHasPermission = fPerm
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "UserHasPermission"
 Resume PROC_EXIT
 
End Function
Public Function UsersInGroupToArray( _
 strWorkspace As String, _
 strGroup As String, _
 astrIn() As String) _
 As Integer
 ' Comments : Populates the passed array with a list of users
 ' Parameters: strWorkspace - Name of the workspace
 '       or "" (blank string) to use the current workgroup
 '       strGroup - Name of the group to check
 '       astrIn - Array of strings (0-based)
 ' Returns  : Number of users in the specified group
 ' Source  : JustACoder
 '
 Dim intCounter As Integer
 Dim intCount As Integer
 Dim wrkTmp As DAO.Workspace
 On Error GoTo PROC_ERR
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Get the count of users and resize the array accordingly
 intCount = wrkTmp.Groups(strGroup).Users.Count
 ReDim astrIn(0 To intCount - 1)
 ' Add each user to the array
 For intCounter = 0 To intCount - 1
  astrIn(intCounter) = wrkTmp.Groups(strGroup).Users(intCounter).Name
 Next intCounter
     
 ' Return the count
 UsersInGroupToArray = intCount
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "UsersInGroupToArray"
 Resume PROC_EXIT
End Function
Public Function UsersInGroupToString( _
 strWorkspace As String, _
 strGroup As String, _
 strIn As String, _
 chrDelimit As String) _
 As Integer
 ' Comments : Populates the passed string with a list of users
 ' Parameters: strWorkspace - Name of the workspace
 '       or "" (blank string) to use the current (0) workgroup
 '       strGroup - Name of the group to check
 '       strIn - String to populate
 '       chrDelimit - Character to use a delimiter between user names
 ' Returns  : Number of users in specified group
 ' Source  : JustACoder
 '
 Dim intCounter As Integer
 Dim intCount As Integer
 Dim wrkTmp As DAO.Workspace
 On Error GoTo PROC_ERR
 
 ' Get the workspace
 If strWorkspace = "" Then
  Set wrkTmp = DAO.DBEngine.Workspaces(0)
 Else
  Set wrkTmp = DAO.DBEngine.Workspaces(strWorkspace)
 End If
 ' Count the users so we know when to stop
 intCount = wrkTmp.Groups(strGroup).Users.Count
 For intCounter = 0 To intCount - 1
  ' Add the user to teh string
  strIn = strIn & wrkTmp.Groups(strGroup).Users(intCounter).Name
  ' If we aren't on the last user, append the delimiter
  If intCounter < intCount - 1 Then
   strIn = strIn & chrDelimit
  End If
 Next intCounter
     
 ' Return the count
 UsersInGroupToString = intCount
PROC_EXIT:
 Exit Function
 
PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "UsersInGroupToString"
 Resume PROC_EXIT
End Function