Add User Form 1

[Samulayo]

I'm using the MS access security system and I was wondering if anyone knew of a way to create a form to add a new user to a workgroup and add him to a certain group.
How easy it is to do this using Access 97?

Regards

Samulayo

 

[JeremyNYC]

Very doable. You should get and read the Security FAQ. It has code to do all of this. There's a copy on my website, or you can get it from MS.

Here's some code from an A2K database that I converted from A97. I don't remember how much of it changed, but I doubt it was much, if anything. Some of this probably came from the FAQ. You'll notice that I'm validating users against the Outlook contact list, because that's a requirement for this particular database. Also, the error code uses my standard error handler. You can get that from my site, if you really want it, but you'll probably want to pull it out. Oh, I guess there are calls to a bunch of subs and functions that I've not included here, but they should all be pretty self explanatory from the name. Hopefully this will give you an idea of how to go about it.

The form is unbound.
Public Function SaveEmployee(fFE As Form_frmEmployee) As Boolean
'(c)Copyright 2/6/01 Jeremy Wallace
On Error GoTo Error
Dim sSql As String, sFullName As String, sInitials As String, sSecurityUserName As String, sTag As String
SaveEmployee = True
With fFE
sFullName = Nz(!txtFullName)
sInitials = Nz(!txtInitials)
sSecurityUserName = Nz(!txtSecurityUserName)
sTag = ""
If sFullName = "" Or sInitials = "" Or sSecurityUserName = "" Then
MsgBox "Please fill in the all fields.", vbExclamation, "Missing Data"
SaveEmployee = False
Exit Function
End If
If InStr(1, sSecurityUserName, " &quot Then
MsgBox "Please choose a 'Security Username' that does not include a space.", _
vbOKOnly, "Data Error"
SaveEmployee = False
Exit Function
End If
If bolResolveAddress(sFullName) = False Then
Call MsgBox("The name you entered does not exist in the Outlook Address Book." _
& " Please enter a qualified name in this field (you may want to use the Outlook" _
& " Address Book function to cut-and-paste a qualified name).", _
vbOKOnly + vbInformation, "Unqualified Name&quot
Exit Function
Else
If !txtID = 0 Then
If CreateUser(sSecurityUserName) = True Then
Dim rst As DAO.Recordset, lngID As Long
sSql = "SELECT * FROM tblEmployee"
Set rst = db.OpenRecordset(sSql, dbOpenDynaset)
rst.AddNew
!txtID = rst!EmployeeID
!txtFullName = sFullName
rst!FullName = sFullName
rst!Initials = sInitials
rst!SecurityUserName = sSecurityUserName
rst.Update
rst.Close
Set rst = Nothing
Else
sTag = "unlockable"
End If
Else
sSql = "UPDATE tblEmployee Set FullName = '" & Ver(Nz(sFullName)) _
& "', Initials= '" & Ver(Nz(sInitials)) & "', SecurityUserName = '" _
& Ver(Nz(sSecurityUserName)) & "'" _
& " WHERE EmployeeID = " & !txtID
Call db.Execute(sSql, dbFailOnError)
End If
Call LockControls(fFE, True)
Call RequerySubforms(fFE.SourceForm)
!txtSecurityUserName.Tag = sTag
End If
End With
Exit Function
Error:
Select Case Err.Number
Case 3315 'zero-length
MsgBox "Please fill in the all fields.", vbExclamation, "Missing Data"
SaveEmployee = False
Case Else
ErrorTrap Err.Number, Err.Description, "SaveEmployee"
End Select
End Function

Public Function CreateUser(ByVal sUserName As String) As Boolean
Dim ws As Workspace
Dim usr As User
Dim grpUsers As Group
Dim sSql As String
Dim sPID As String
Dim sPWD As String

Set ws = DBEngine.Workspaces(0)
ws.Users.Refresh
On Error Resume Next
sUserName = ws.Users(sUserName).Name
If Err.Number = 0 Then
Call MsgBox("The user you are trying to add already exists.", vbOKOnly + vbInformation, _
"Can't Add User&quot
CreateUser = False
Else
sPID = "sdf34" & sUserName
sPWD = sUserName
Set usr = ws.CreateUser(sUserName, sPID, sPWD)
ws.Users.Append usr
ws.Users.Refresh
Set grpUsers = ws.Groups("BRUsers&quot
Set usr = grpUsers.CreateUser(sUserName)
Call grpUsers.Users.Append(usr)
Set grpUsers = ws.Groups("Users&quot
Set usr = grpUsers.CreateUser(sUserName)
Call grpUsers.Users.Append(usr)
Call grpUsers.Users.Refresh
CreateUser = True
End If
Exit Function
End Function

Hope this helps.

Jeremy

PS: I'm sure there are plenty of ugly line breaks. Sorry for that.

==
Jeremy Wallace
AlphaBet City Dataworks

http://www.ABCDataworks.com

Affordable Development, Professionally Done

Please post in the appropriate forum with a descriptive subject; code and SQL, if referenced; and expected results. See thread181-473997 for more pointers.

 

[Samulayo]

Thank you very much, I shall try this out over the next couple of days to see what I can produce.
Have a star for your trouble

Regards

Samulayo