Security: Add/Delete Users From Form in Code

Tuesday, June 17, 2003 00:53:43

Wow. I really plugged away tinkering around with solutions found at Google newsgroup searching. Finally, I found one that halfway worked, once I figured a couple of things on my own and tinkered with it.

Thing is, it was really simple adding a new user in code. The problem was having this user joined to one group at a time. Creating the user and assigning it to a particular group at that time was easy. But to specify that the user should also be joined to another group, that was very difficult for me to figure out how to do. Finally, largely by using my one instincts frankly, I figured out how.

The steps:

Create a blank, unbound form. Add a text box named txtUserName. Add 2 command buttons, one named cmdAddUser and another named cmdDeleteUser.

Save this form as frmAddDeleteUsers

Make sure in your security that ONLY an authorized person can open this form; as it's designed, anyone who can open this form can add users, even if their permissions otherwise are limited.

Enter the following code in the form:

Private Sub cmdAddUser_Click()
Call CreateNewUser(Me.txtUserName)
End Sub

Private Sub cmdDeleteUser_Click()
Call delete_user(Me.txtUserName)
End Sub

Create a new module, name it basAddDeleteUser

Enter the following code in the module:


Public Sub CreateNewUser(ByVal strUser As String)

' Create a new user and add them to the Full Data Users group and then to the Users Group
' Returns True on success, False if user already exists
   Dim db As Database
   Dim ws As Workspace
   Dim usr As User
   Dim grpUsers As Group
   Dim strPID As String

' The Next 3 lines are commented out; there appears to be
'  a missing function for detecting if the user you're attempting to add already exists. 
' As it stands, if the operator tries to do this, an error results; error-trapping
' would seem to be the way to handle this if I can't figure out the IsUser function.

'If IsUser(strUser) = True Then
   '   Exit Sub
'End If

'Set ws = DBEngine.Workspaces(0)
' The above set ws is commented out as that was what originally appeared 
' in the code I found. Problem is, only admins could 
' add/delete users.  In my experimentation,  the following edit sort of 
' "logs in" as administrator thus allowing anyone opening this form to add/delete users.
' I wonder if {Dim ws as Workspace} should read {Dim ws as DAO.Workspace}
' I also wonder if {Dim usr as User} should read {Dim usr as DAO.User}. 
' Notice the delete_user function has that syntax.

Set ws = DBEngine.CreateWorkspace("AdminWorkspace", "AdminID", _
        "AdminPassword")
   Const conGroup As String = "Full Data Users"
   ws.Users.Refresh
   ' go ahead and create the user account

   strPID = strUser & strUser
   strPID = Left(strPID, 20)     ' max 20 chars
   
With ws
    Set usr = .CreateUser(strUser, strPID, "")
    .Users.Append usr
    Set grpUsers = usr.CreateGroup(conGroup)
    usr.groups.Append grpUsers
End With
   
'***********************************
' FINALLY FIGURED IT OUT!! This code adds the new user
' to the group Users after having created it and joined it
' to the "Full Data Users" group in the prior code.

With ws
    Set grpUsers = usr.CreateGroup("Users")
    usr.groups.Append grpUsers
End With
ws.Users.Refresh
'***********************************

MsgBox "New user = " & strUser
Set ws = Nothing
Set usr = Nothing
End Sub

Function delete_user(stUsr As String)
' Delete User
Dim wrk As DAO.Workspace
Dim usr As DAO.User
  Set wrk = DBEngine.CreateWorkspace _
        ("", "AdminUser", "AdminPassword", dbUseJet)
  wrk.Users.Delete stUsr
Set wrk = Nothing
Set usr = Nothing
MsgBox "User " & stUsr & " has been deleted."
End Function