code to delete a user/ code to move users into and out of groups

  • Thread starter Thread starter Guest
  • Start date Start date
'Enumerate all users and groups
Public Sub EnumUsersAndGroups()
Dim wrk As DAO.Workspace
Dim grp As DAO.Group
Dim usr As DAO.User

Set wrk = DBEngine(0)

'Enumerate the groups
Debug.Print "Groups."
For Each grp In wrk.Groups
Debug.Print vbTab & grp.Name
Next grp

'Enumerate the users
Debug.Print "Users."
For Each usr In wrk.Users
Debug.Print vbTab & usr.Name
Next usr

Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Enumerate the users belonging to a specific group
Public Sub EnumGroupUsers(strGroup As String)
Dim wrk As DAO.Workspace
Dim varUser As Variant

Set wrk = DBEngine(0)

Debug.Print "Users belonging to the '" & strGroup & "' group..."
For Each varUser In wrk.Groups(strGroup).Users
Debug.Print vbTab & varUser.Name
Next varUser

Set wrk = Nothing
End Sub

'-------
'Enumerate the groups a specific user belongs to
Public Sub EnumUserGroups(strUser As String)
Dim wrk As DAO.Workspace
Dim varGroup As Variant

Set wrk = DBEngine(0)

Debug.Print "Groups to which user '" & strUser & "' belongs..."
For Each varGroup In wrk.Users(strUser).Groups
Debug.Print vbTab & varGroup.Name
Next varGroup

Set wrk = Nothing
End Sub

'-------
'Create a group
Public Sub CreateUserGroup(strGroupName As String, _
strPID As String)
Dim wrk As DAO.Workspace
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error GoTo CreateUserGroupErr

'Create the new group
Set grp = wrk.CreateGroup(strGroupName, strPID)
ws.Groups.Append grp

CreateUserGroupErr:
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Delete a group
Public Sub DeleteGroup(strGroup As String)
On Error Resume Next
DBEngine(0).Groups.Delete strGroup
End Sub

'-------
'Create a user
Public Function CreateUserAccount(strUserName As String, _
strPID As String, strPassword As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User

Set wrk = DBEngine(0)
On Error GoTo CreateUserAccountErr

'Create the new user
Set usr = wrk.CreateUser(strUserName, strPID, strPassword)
wrk.Users.Append usr

CreateUserAccountErr:
Set usr = Nothing
Set wrk = Nothing
End Function

'-------
'Delete a user
Public Sub DeleteUser(strUser As String)
On Error Resume Next
DBEngine(0).Users.Delete strUser
End Sub

'-------
'Add a group to a user
Public Sub AddGroup2User(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error Resume Next

'Create object references
Set usr = wrk.Users(strUser)
Set grp = usr.CreateGroup(strGroup)

'Add the group to the user's Groups collection
usr.Groups.Append grp
usr.Groups.Refresh

Set usr = Nothing
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Add a user to a group
Public Sub AddUser2Group(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error Resume Next

'Create object references
Set grp = wrk.Groups(strUser)
Set usr = grp.CreateUser(strUser)

'Add the group to the user's Groups collection
grp.Users.Append usr
grp.Users.Refresh

Set usr = Nothing
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Remove a user from a group
Public Sub DeleteUserFromGroup(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace

Set wrk = DBEngine(0)
On Error Resume Next

wrk.Users(strUser).Groups.Delete strGroup

Set wrk = Nothing
End Sub

'-------
'Determine if a user belongs to a specific group
Public Function IsUserInGroup (strUser As String, _
strGroup As String) As Boolean
Dim wrk As DAO.Workspace

Set wrk = DBEngine(0)
On Error Resume Next

IsUserInGroup = False

'Check in the Users --> Groups collection
IsUserInGroup = _
(wrk.Users(strUser).Groups(strGroup).Name = strGroup)

'You can also do it this way...
'Check in the Groups --> Users collection
'IsUserInGroup = _
(wrk.Groups(strGroup).Users(strUser).Name = strUser)

Set wrk = Nothing
End Function

'-------
'Change a user's password
Public Sub ChangePassword(strUser As String, _
strOldPassword As String, strNewPassword As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User

Set wrk = DBEngine(0)
Set usr = wrk.Users(strUser)

'Change the password
usr.NewPassword strOldPassword, strNewPassword

Set usr = Nothing
Set wrk = Nothing
End Sub

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia
---------------------------
 
Thanks, I check these out.

Graham R Seach said:
'Enumerate all users and groups
Public Sub EnumUsersAndGroups()
Dim wrk As DAO.Workspace
Dim grp As DAO.Group
Dim usr As DAO.User

Set wrk = DBEngine(0)

'Enumerate the groups
Debug.Print "Groups."
For Each grp In wrk.Groups
Debug.Print vbTab & grp.Name
Next grp

'Enumerate the users
Debug.Print "Users."
For Each usr In wrk.Users
Debug.Print vbTab & usr.Name
Next usr

Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Enumerate the users belonging to a specific group
Public Sub EnumGroupUsers(strGroup As String)
Dim wrk As DAO.Workspace
Dim varUser As Variant

Set wrk = DBEngine(0)

Debug.Print "Users belonging to the '" & strGroup & "' group..."
For Each varUser In wrk.Groups(strGroup).Users
Debug.Print vbTab & varUser.Name
Next varUser

Set wrk = Nothing
End Sub

'-------
'Enumerate the groups a specific user belongs to
Public Sub EnumUserGroups(strUser As String)
Dim wrk As DAO.Workspace
Dim varGroup As Variant

Set wrk = DBEngine(0)

Debug.Print "Groups to which user '" & strUser & "' belongs..."
For Each varGroup In wrk.Users(strUser).Groups
Debug.Print vbTab & varGroup.Name
Next varGroup

Set wrk = Nothing
End Sub

'-------
'Create a group
Public Sub CreateUserGroup(strGroupName As String, _
strPID As String)
Dim wrk As DAO.Workspace
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error GoTo CreateUserGroupErr

'Create the new group
Set grp = wrk.CreateGroup(strGroupName, strPID)
ws.Groups.Append grp

CreateUserGroupErr:
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Delete a group
Public Sub DeleteGroup(strGroup As String)
On Error Resume Next
DBEngine(0).Groups.Delete strGroup
End Sub

'-------
'Create a user
Public Function CreateUserAccount(strUserName As String, _
strPID As String, strPassword As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User

Set wrk = DBEngine(0)
On Error GoTo CreateUserAccountErr

'Create the new user
Set usr = wrk.CreateUser(strUserName, strPID, strPassword)
wrk.Users.Append usr

CreateUserAccountErr:
Set usr = Nothing
Set wrk = Nothing
End Function

'-------
'Delete a user
Public Sub DeleteUser(strUser As String)
On Error Resume Next
DBEngine(0).Users.Delete strUser
End Sub

'-------
'Add a group to a user
Public Sub AddGroup2User(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error Resume Next

'Create object references
Set usr = wrk.Users(strUser)
Set grp = usr.CreateGroup(strGroup)

'Add the group to the user's Groups collection
usr.Groups.Append grp
usr.Groups.Refresh

Set usr = Nothing
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Add a user to a group
Public Sub AddUser2Group(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group

Set wrk = DBEngine(0)
On Error Resume Next

'Create object references
Set grp = wrk.Groups(strUser)
Set usr = grp.CreateUser(strUser)

'Add the group to the user's Groups collection
grp.Users.Append usr
grp.Users.Refresh

Set usr = Nothing
Set grp = Nothing
Set wrk = Nothing
End Sub

'-------
'Remove a user from a group
Public Sub DeleteUserFromGroup(strUser As String, _
strGroup As String)
Dim wrk As DAO.Workspace

Set wrk = DBEngine(0)
On Error Resume Next

wrk.Users(strUser).Groups.Delete strGroup

Set wrk = Nothing
End Sub

'-------
'Determine if a user belongs to a specific group
Public Function IsUserInGroup (strUser As String, _
strGroup As String) As Boolean
Dim wrk As DAO.Workspace

Set wrk = DBEngine(0)
On Error Resume Next

IsUserInGroup = False

'Check in the Users --> Groups collection
IsUserInGroup = _
(wrk.Users(strUser).Groups(strGroup).Name = strGroup)

'You can also do it this way...
'Check in the Groups --> Users collection
'IsUserInGroup = _
(wrk.Groups(strGroup).Users(strUser).Name = strUser)

Set wrk = Nothing
End Function

'-------
'Change a user's password
Public Sub ChangePassword(strUser As String, _
strOldPassword As String, strNewPassword As String)
Dim wrk As DAO.Workspace
Dim usr As DAO.User

Set wrk = DBEngine(0)
Set usr = wrk.Users(strUser)

'Change the password
usr.NewPassword strOldPassword, strNewPassword

Set usr = Nothing
Set wrk = Nothing
End Sub

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia
Click to expand...
 
I have added the code below to delete a user, and it seems to be working,
however to see the results, you need to exit the project and return. When
you return the user is no longer there.
 
tw wrote:

(snip)


Be careful! In at least one version of Access/Jet, if you changed the
/current user's/ groups at runtime, the changes were visible in the
relevant collections, but they did not actually /take effect/ until you
logged-out, then logged back in.

So, if you plan to change the /current user's/ groups at runtime, do
some simple testing first, to be sure that it will work the way you
expect.

HTH,
TC
 
It's there but not working. I see TC's post until after I posted mine, but
it's working like TC said it does. Is there a way to enable the system menu
for the admin users, but not for anyone else?? I know there should be a way
for me to have a custom menu but I havn't figured it out yet so I have
disable the menu on start up and am using a switchboard. but I'd like to
also have a menu and include the security features for the admin user.
 
That behaviour is probably more to do with refreshing the document
collections.

You might try:
(a) refreshing the Containers collection:
CurrentDb.Containers.Refresh

(b) refreshing the Documents collection
CurrentDb.Containers("Tables").Documents.Refresh

(c) explicitly setting access permissions to each object for the user:
Public Sub RemoveUserTablePermissions( _
strUserName As String, strTableName As String)
Dim db As DAO.Database
Dim doc As DAO.Document

Set db = CurrentDb
Set doc = db.Containers("Tables").Documents(strTableName)

doc.UserName = strSomeUser
doc.Permissions = dbSecNoAccess

Set doc = Nothing
Set db = Nothing
End Sub

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia

Microsoft Access 2003 VBA Programmer's Reference
http://www.wiley.com/WileyCDA/WileyTitle/productCd-0764559036.html
 
Um, currentdb() refreshes all collections automatically. currentdb.<any
collection>.refresh would be superfluous, IMO.

Here's an earlier thread to do with a user's permissions /not/ changing
until he logged out & back in again:

group: this
subject: Group permissions set at startup?
date: July 2003

HTH,
TC
 
Sorry, I don't understand what you're saying.

I'm not suggesting that you "refresh 100 collections in order to
"simplify" refreshing one."

I'm suggesting that you /don't/ refresh 100 collections, when you only
/want/ to refresh /some/.

(a) This refreshes *all* collections, *three times*:

currentdb.<this>.refresh.
currentdb.<that>.refresh.
currentdb.<t'other>.refresh.

(b) This refreshes all collections, *once* (and is therefore three
times faster than (a)):

currentdb (as a statement!)

(c) This refreshes just the collections that you want, once each (and
is thus the most efficient of all three methods):

dbengine(0)(0).<this>.refresh
dbengine(0)(0).<that>.refresh
dbengine(0)(0).<t'other>.refresh

I'm suggesting to do (c), or (b), in clear preference to (a).

Cheers,
TC
 
Back
Top