At my company we are still running Access 97. During my tenure here I have created several databases with user-level security and, using Microsoft's Knowledge Base, I created many easy to use forms for such tasks as adding new users, changing user security levels, changing user passwords, etc. (all the code I'm using is below...there's quite a bit).
It all accesses the Microsoft MDW file using DAO.
Now we are moving to Windows XP and Office XP (2002). My code will compile, it will even run, but what it will not do is add or modify any information in the security file. I have been web surfing for several hours on this problem...does anyone know where I can find tips on where to begin either modifying the below code or starting over?
Thank you!!!!!!!!!!!!!!!!
It all accesses the Microsoft MDW file using DAO.
Now we are moving to Windows XP and Office XP (2002). My code will compile, it will even run, but what it will not do is add or modify any information in the security file. I have been web surfing for several hours on this problem...does anyone know where I can find tips on where to begin either modifying the below code or starting over?
Thank you!!!!!!!!!!!!!!!!
Code:
Option Compare Database
Option Explicit
Function faq_IsUserInGroup(strGroup As String, strUser As String) As Integer
' Returns True if user is in group, False otherwise
' This only works if you're a member of the Admins group.
Dim ws As Workspace
Dim grp As Group
Dim StrUsername As String
Set ws = DBEngine.Workspaces(0)
Set grp = ws.Groups(strGroup)
On Error Resume Next
StrUsername = ws.Groups(strGroup).Users(strUser).Name
faq_IsUserInGroup = (Err = 0)
End Function
Public Function CreateUser(ByVal strUser As String, ByVal _
strPID As String, ByVal gname As String, Optional varPwd As Variant) As Integer
'---------------------------------------------------------------
' Create a new user and add them to the group specified by gname
' and to the default 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 strSQL As String
' if the password isn't supplied, make sure you
' pass an empty string for the password argument
If IsMissing(varPwd) Then varPwd = ""
Set ws = DBEngine.Workspaces(0)
ws.Users.Refresh
On Error Resume Next
' check to see if user already exists by using inline
' error handling to trap any errors caused by setting
' a reference to a possibly non-existent user
strUser = ws.Users(strUser).Name
If Err.number = 0 Then
MsgBox "The user you are trying to add already exists.", _
vbInformation, "Can't Add User"
CreateUser = False
Else
' go ahead and create the user account
Set usr = ws.CreateUser(strUser, strPID, varPwd)
ws.Users.Append usr
ws.Users.Refresh
' now add the user to the Users group
Set grpUsers = ws.Groups(gname)
Set usr = grpUsers.CreateUser(strUser)
grpUsers.Users.Append usr
grpUsers.Users.Refresh
' now add the user to the chosen group
Set grpUsers = ws.Groups("Users")
Set usr = grpUsers.CreateUser(strUser)
grpUsers.Users.Append usr
grpUsers.Users.Refresh
CreateUser = True
End If
End Function
Public Function ChangeResetPassword(StrAction As String, StrUsername As _
String, StrAdminLogon As String, StrAdminPass As String, Optional _
StrNewPassword As Variant) As Boolean
ChangeResetPassword = False
Dim ws As Workspace
On Error GoTo ChangeResetPassword:
' Create a new Administrative Workspace. If The StrAction passed to the
' function is "Change" then change the Password of the User named in
' StrUsername to the password saved in StrNewPassword.
' If the StrAction passed is "Reset", Then reset the password of
' the User mentioned in StrUsername. If neither "Change" or "Reset"
' is passed to the function in the StrAction argument, inform the
' user of an error and exit the procedure.
Set ws = DBEngine.CreateWorkspace("AdminWorkspace", StrAdminLogon, _
StrAdminPass)
If StrAction = "change" Then
If Not IsNull(StrNewPassword) Then
ws.Users(StrUsername).NewPassword "", StrNewPassword
MsgBox "Password Change Successful", vbOKOnly
ChangeResetPassword = True
Else
MsgBox "When Attempting to Change A User's Password, You " & _
"Must Include a New Password", vbOKOnly
End If
ElseIf StrAction = "reset" Then
ws.Users(StrUsername).NewPassword "", ""
MsgBox "Password Successfully Reset", vbOKOnly
Else
MsgBox "You must Select a StrAction of either '" & "Change'" & _
"' or '" & "Reset'.", vbOKOnly
End If
ws.Close
Set ws = Nothing
Exit Function
ChangeResetPassword:
MsgBox Err.Description
End Function
Public Function ChangeUserPassword(StrUsername As String, StrOldPassword As String, StrNewPassword As String) _
As Boolean
Dim Response As Variant
ChangeUserPassword = False
On Error GoTo ChangeUserPassword_Err:
DBEngine(0).Users(StrUsername).NewPassword StrOldPassword, StrNewPassword
ChangeUserPassword = True
MsgBox "Password Change Successful", vbInformation
Exit Function
ChangeUserPassword_Err:
If Err.number = 3033 Then
Response = MsgBox("Access violation. Your original password was incorrect " & _
"or you do not have permissions to modify this password.", vbOKOnly, "Password Error")
ChangeUserPassword = False
Else
MsgBox Err.Description
End If
End Function
Public Sub ChangeUserGroup(StrUsername As String, newgroup As String)
Dim Response As Variant
Dim db As Database
Dim ws As Workspace
Dim usr As User
Dim grpUsers As Group
Dim strSQL As String
Dim oldgroup As String
If newgroup = "Admins" Then oldgroup = "Modifiers"
If newgroup = "Modifiers" Then oldgroup = "Admins"
Set ws = DBEngine.Workspaces(0)
ws.Users.Refresh
On Error Resume Next
' check to see if user already exists by using inline
' error handling to trap any errors caused by setting
' a reference to a possibly non-existent user
StrUsername = ws.Users(StrUsername).Name
If Err.number = 0 Then
Set usr = ws.CreateUser(StrUsername, "strPID", "varPwd")
ws.Users.Refresh
' now add the user to the group
Set grpUsers = ws.Groups(newgroup)
Set usr = grpUsers.CreateUser(StrUsername)
grpUsers.Users.Append usr
grpUsers.Users.Refresh
Set grpUsers = ws.Groups(oldgroup)
grpUsers.Users.Delete (StrUsername)
grpUsers.Users.Refresh
MsgBox "User's group successfully changed.", _
vbInformation, "Change Successful"
Else
MsgBox "The user you are trying to modify doesn't exist.", _
vbInformation, "Can't Modify User"
End If
End Sub