Tools Links Login

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

This module contains procedures for working with the Microsoft Jet User-Level Security model in terms of user, groups, passwords and permissions.

Original Author: JustACoder

Assumptions

Each of the procedures in this module require that you pass a workgroup name to identify the workgroup you want to work with. By default, Visual Basic doesn't open a workgroup information file (*.MDA, *.MDW) unless you specify the SystemDB property of the DAO DBEngine object. When you specify a value for this property, the default DAO Workspace object, also known as Workspaces(0) is mapped to the workgroup information file you specify. In such a case, specifying a blank value for the strWorkgroup parameter of the procedures in this module effectively uses whatever workgroup information file you are currently using.

Code

' 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

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 116 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.