Access Cookbook - Ken Getz [213]
' workgroup.
'
' The results will be in:
' tblUsers, tblGroups and
' tblUserGroups.
' Run qryUserGroups to see sorted list.
Dim db As DAO.Database
Dim wrk As DAO.Workspace
Dim rstUsers As DAO.Recordset
Dim rstGroups As DAO.Recordset
Dim rstUserGroups As DAO.Recordset
Dim usr As User
Dim intI As Integer
Dim intJ As Integer
' Set up object variables.
Set wrk = DBEngine.Workspaces(0)
Set db = wrk.Databases(0)
Set rstUsers = db.OpenRecordset("tblUsers")
Set rstGroups = db.OpenRecordset("tblGroups")
Set rstUserGroups = db.OpenRecordset("tblUserGroups")
' Refresh the Users and Groups collections
' so we see any recently added members
wrk.Users.Refresh
wrk.Groups.Refresh
' Clear out the old values
db.Execute "DELETE * FROM tblUserGroups"
db.Execute "DELETE * FROM tblUsers"
db.Execute "DELETE * FROM tblGroups"
' Build up a list of all the groups in tblGroups
For intI = 0 To wrk.Groups.Count - 1
rstGroups.AddNew
rstGroups("Group") = wrk.Groups(intI).Name
rstGroups.Update
Next intI
' Loop through all the users, adding
' rows to tblUsers and tblUserGroups.
For intI = 0 To wrk.Users.Count - 1
' Add a user to tblUsers.
Set usr = wrk.Users(intI)
rstUsers.AddNew
rstUsers("UserName") = usr.Name
rstUsers.Update
rstUsers.Move 0, rstUsers.LastModified
' Now loop through all the groups
' that user belongs to, hooking up the rows
' in tblUserGroups.
For intJ = 0 To usr.Groups.Count - 1
rstGroups.Index = "Group"
rstGroups.Seek "=", usr.Groups(intJ).Name
If Not rstUserGroups.NoMatch Then
rstUserGroups.AddNew
rstUserGroups("UserID") = rstUsers("UserID")
rstUserGroups("GroupID") = rstGroups("GroupID")
rstUserGroups.Update
End If
Next intJ
Next intI
rstUsers.Close
rstGroups.Close
rstUserGroups.Close
End Sub
Either import the query qryUserGroups from 10-05.MDB, or create a new query, as follows. When Access asks you to add a table, just close the dialog. In design mode, click on the SQL button on the toolbar and enter the following expression:
SELECT tblUsers.UserName, tblGroups.Group
FROM tblUsers INNER JOIN (tblGroups INNER JOIN tblUserGroups
ON tblGroups.GroupID = tblUserGroups.GroupID)
ON tblUsers.UserID = tblUserGroups.UserID
ORDER BY tblUsers.UserName, tblGroups.Group;
Then save the query as qryUserGroups.
To produce the current list of users and groups, execute the code in acbListUsers. You can call it directly, use a button whose Click event calls the procedure, or call it from the debug window. (The sample form calls acbListUsers from the Click event of the cmdRequery button on the form.) Once you've executed that code, you'll have filled in the three tables. You can use qryUserGroups to retrieve the information you need, or create your own queries based on the three tables.
Discussion
This solution relies on the DAO object model to gather its information. The DBEngine object is at the root (the highest level) of the DAO object hierarchy, and it has a single collection, the Workspaces collection. Each workspace represents a session of the Access database engine (and unless you're writing sophisticated applications, you'll most likely never see more than a single concurrent workspace). The default workspace contains information about the collection of open databases (only one is open in the user interface—all others must be opened via VBA code) along with the available user and group collections. These are the collections you'll need for filling tables with the usernames and their groups. The code in the acbListUsers subroutine does all the work.
The acbListUsers function starts out by setting up object variables to refer to several recordset objects, and refreshes the Users and Groups collections of the workspace. This is necessary to make sure we see any recent changes to these collections made via the Access user interface or by another Access session. The relevant code is:
' Set up object variables.
Set wrk = DBEngine.Workspaces(0)
Set db = wrk.Databases(0)
Set rstUsers = db.OpenRecordset("tblUsers")
Set rstGroups = db.OpenRecordset("tblGroups")