I am fairly new to Access and even moreso to coding. This database is the first one I've ever had to creat for work purposes. I am working on secuing the DB and got some help with a form for Users to change their passwords. My little helper is no longer available!
Can someone please look at this code and help me to see what's wrong? My offie is running Microsoft Office XP.
Can someone please look at this code and help me to see what's wrong? My offie is running Microsoft Office XP.
Code:
'==================================================================='
' '
' Change Password Form '
' '
'==================================================================='
' Open this form as a dialog whenever the user needs to change his/her password.
' Members of the Admins group are allows to change any user's password.
Option Compare Database
Option Explicit
Dim strUserName As String
Private Sub cboUserName_AfterUpdate()
strUserName = cboUserName
End Sub
Private Sub cmdCancel_Click()
DoCmd.Close
End Sub
Private Sub cmdOK_Click()
Dim strOldPW As String, strNewPW As String, strVerifyPW As String
strOldPW = Nz(txtOldPw)
strNewPW = Nz(txtNewPW)
strVerifyPW = Nz(txtVerify)
If strNewPW <> strVerifyPW Then
txtNewPW.SetFocus
Beep
MsgBox "The New Password does not match the Verify password" _
& vbCrLf & vbCrLf & "Verify the password by retyping it in the " _
& "Verify box and clicking OK", vbExclamation
Exit Sub
End If
On Error GoTo ErrorHandler
DBEngine(0).Users(strUserName).NewPassword strOldPW, strNewPW
MsgBox "The password has been changed", vbInformation
DoCmd.Close
ErrorExit:
Exit Sub
ErrorHandler:
If Err.Number = 3033 Then
Beep
MsgBox "The password you entered into the Old Password box is incorrect." _
& vbCrLf & vbCrLf _
& "Please enter the correct password for this account.", vbInformation
txtOldPw.SetFocus
Resume ErrorExit
Else
Beep
MsgBox "Run time error (" & Err.Number & "):" & vbCrLf & vbCrLf _
& Err.Description, vbExclamation
DoCmd.Close
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
strUserName = CurrentUser()
If UserIsInGroup(strUserName, "Admins") Then
cboUserName.RowSource = UserNameList()
cboUserName = strUserName
cboUserName.Visible = True
txtUserName.Visible = False
Else
txtUserName = strUserName
txtUserName.Visible = True
cboUserName.Visible = False
End If
End Sub
Private Function UserIsInGroup(UserName As String, GroupName As String) As Boolean
Dim grp As ADO.Group
On Error Resume Next
Set grp = DBEngine(0).Users(UserName).Groups(GroupName)
UserIsInGroup = Not grp Is Nothing
Set grp = Nothing
End Function
Private Function UserNameList()
Dim usr As DAO.User
Dim strResult As String
For Each usr In DBEngine(0).Users
If usr.Name <> "Creator" And usr.Name <> "Engine" Then _
strResult = strResult & usr.Name & ","
Next usr
UserNameList = Left$(strResult, Len(strResult) - 1)
End Function