message
Hi Justin,
Comments in-line and below.....
Hi again, your solution was perfect, however, the way I set up my UI (like the
user/group accounts dialog from Access) I have two list boxes. But they don't
update/refresh after I add/remove a user from a group
Good to hear you are making progress.
here's the code for clicking on the add button
Private Sub cmd_add_Click()
On Error GoTo Err_cmd_add_Click
Dim wrk As DAO.Workspace
Dim grp As DAO.Group
Dim usr As DAO.User
Dim selectedGroup As String
Set wrk = DBEngine.CreateWorkspace("", "tmsadmin", "retroo", dbUseJet)
selectedGroup = Me.lst_available.value
wrk.Users.Refresh
' Now add the user to the group
Set grp = wrk.Groups(selectedGroup)
Set usr = grp.CreateUser(Me.cmb_empID)
grp.Users.Append usr
grp.Users.Refresh
wrk.Groups.Refresh
wrk.Users.Refresh
Exit_cmd_add_Click:
Set grp = Nothing
Set usr = Nothing
Set wrk = Nothing
refresh_lst_member
Exit Sub
Err_cmd_add_Click:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_cmd_add_Click
End Sub
That all looks pretty good, but I have suggestions for improvements
further down.
Comments inside the next code section below....
and the refresh sub
Private Sub refresh_lst_member()
On Error GoTo Err_refresh_lst_member
Dim db As Database
I'm not sure why you need this at all.
Dim usr As User
Dim memberGroups As String
Set db = CodeDb
You do not need to set a reference to CodeDb or CurrentDb
in this instance. I am also wondering why you are using CodeDb,
but we will be removing it anyway so it does not matter.
'Get "member of" groups
Set usr = DBEngine.Workspaces(0).Users(Me.cmb_empID)
Right here you should Refresh the Groups Collection for this user.
For i = 0 To usr.Groups.Count - 1
I believe you forgot to Dim I as an Integer.
You would have received an error right off the bat.
You may have it declared and it just did not show up in your copy/paste.
memberGroups = memberGroups & """" & usr(i).Name & """" & ";"
Next
memberGroups = Left$(memberGroups, Len(memberGroups) - 1)
Me.lst_member.RowSourceType = "Value List"
If your List Box is already set to "Value List" you do not need this.
Me.lst_member.RowSource = memberGroups
Exit_refresh_lst_member:
Set db = Nothing
Again, not needed.
Set usr = Nothing
Exit Sub
Err_refresh_lst_member:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_refresh_lst_member
End Sub
After Dimming I as an Integer, your code worked just fine for me when clicking the
Add button. The selected group was now shown in the lst_member List Box.
However, if I chose another one, the list box would not show this second one
as you already observed.
Also, I think it would be a good idea to handle the situation (quite likely) when
trying to put someone into a Group that they are already a member of. Trust me,
someone will accidentally do this at some point.
Are you open to some coding style changes? If so, make a backup of your
database and copy/paste this new code into those two procedures. Compile
the code, save and close the form. Then test it out.
'*****Start Of New Code*****
Private Sub cmd_add_Click()
On Error GoTo Err_cmd_add_Click
Dim wrk As DAO.Workspace
Dim grp As DAO.Group
Dim usr As DAO.User
Dim strSelectedGroup As String
If (Nz(Me![cmb_empID], "") = "") Then
' No User has been selected
MsgBox "Please select a User from the list provided " _
& "before continuing.", vbExclamation, "Which User?"
Me.cmb_empID.SetFocus
GoTo Exit_cmd_add_Click
End If
If Me.lst_available.ItemsSelected.Count = 0 Then
' No Group was selected
MsgBox "Please select an available group from the list " _
& "provided before continuing.", vbExclamation, "Which Group?"
Me.lst_available.SetFocus
GoTo Exit_cmd_add_Click
End If
Set wrk = DBEngine.CreateWorkspace("", "tmsadmin", "retroo", dbUseJet)
strSelectedGroup = Me.lst_available.Value
' Refresh the Users collection
wrk.Users.Refresh
' Now add the user to the group
Set grp = wrk.Groups(strSelectedGroup)
Set usr = grp.CreateUser(Me.cmb_empID)
grp.Users.Append usr
' Refresh all the various collections
grp.Users.Refresh
wrk.Groups.Refresh
wrk.Users.Refresh
' Refresh the list of group membership
Refresh_lst_member
Exit_cmd_add_Click:
On Error Resume Next
Set grp = Nothing
Set usr = Nothing
Set wrk = Nothing
Exit Sub
Err_cmd_add_Click:
If Err.Number = 3032 Then
' This person already belongs to this group
MsgBox Me.cmb_empID & " is already a member of the " _
& Me.lst_available & " group.", vbInformation, _
"Membership Already Exists"
Else
MsgBox Err.Number & ": " & Err.Description
End If
Resume Exit_cmd_add_Click
End Sub
Private Sub Refresh_lst_member()
On Error GoTo Err_Refresh_lst_member
Dim usr As DAO.User
Dim intI As Integer
Dim strMemberGroups As String
' Gather a list of groups this person is a member of
Set usr = DBEngine.Workspaces(0).Users(Me.cmb_empID)
' Refresh this User's Groups collection
usr.Groups.Refresh
' Loop through each group this person is a member of
' and build a text string for our list box
For intI = 0 To usr.Groups.Count - 1
strMemberGroups = strMemberGroups & """" & usr(intI).Name & """" & ";"
Next
' Strip trailing ;
strMemberGroups = Left$(strMemberGroups, Len(strMemberGroups) - 1)
' Pass the completed list of group membership to list box
Me.lst_member.RowSource = strMemberGroups
Exit_Refresh_lst_member:
On Error Resume Next
Set usr = Nothing
Exit Sub
Err_Refresh_lst_member:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Refresh_lst_member
End Sub
'*****End of Revised Code*****
Seems to work just fine in my testing.
Also, I would assume you have already set your combo box of users
to "Limit To List" and coded a Not In List event procedure.
One last thing. On your Remove code button, make sure you prevent
data entry people from trying to remove someone from the Users Group.
Everyone has to be a member of the Users Group.
You're very welcome, I hope it helps.
