Access - Control de acceso

Estimados:
Necesito su ayuda.
el codigo abajo descrito me permite que otros usurios puedan ingresar a mi base de datos, mas sin embargo no les permite cambiar su contraseña. esto solo lo puede hacer el que tiene el primer id.
Gracias de antemano y saludos.


Option Compare Database
Option Explicit
Dim NumIntentos As Integer

Private Sub CmdAcceder_Click()
Dim auxContraseña As String

'Comprobamos que hay datos en las cajas de texto
If Nz(Me.TxtUsuario.Value, "") = "" Then
MsgBox "Seleccione un nombre de usuario de la lista para acceder", vbInformation, "ATENCION"
Me.TxtUsuario.SetFocus
ElseIf Nz(Me.TxtContraseña.Value, "") = "" Then
MsgBox "Introduzca la contraseña del usuario seleccionado", vbInformation, "ATENCION"
Me.TxtContraseña.SetFocus
Else
If Nz(DLookup("Contraseña", "EmpleadosC", "IdEmpleadoC=" & Me![TxtUsuario]), "") <> "" Then
auxContraseña = DLookup("Contraseña", "EmpleadosC", "IdEmpleadoC=" & Me![TxtUsuario])
End If

If auxContraseña <> Me.TxtContraseña.Value Then
If NumIntentos > 1 Then
NumIntentos = NumIntentos - 1
MsgBox "La contraseña introducida es incorrecta" & vbCrLf & _
"Le quedan " & NumIntentos & " intentos" & vbCrLf & vbCrLf & _
"Por favor, introduzca otra", vbExclamation, "INTRODUCCIÓN INCORRECTA"
Me.TxtContraseña.Value = ""
Me.TxtContraseña.SetFocus
Else
MsgBox "Ha superado el numero de intentos", vbCritical, "ADIOS..."
Application.Quit
End If

Else
If DLookup("IdTipoAcceso", "EmpleadosC", "IdEmpleadoC=" & Me![TxtUsuario]) = 1 Then
'**entrada como administrador

MsgBox "Acceso Autorizado,", vbInformation, "BIENVENIDO ADMINISTRADOR"
Call MuestraTodasTablas
Else
MsgBox "Que tengas un buen dia, Puede proceder", vbInformation, "BIENVENIDO USUARIO"
Call OcultaTodasTablas
End If
'DoCmd.OpenForm stDocName, , , stLinkCriteria 'Abrimos el formulario correspondiente
DoCmd.Close acForm, Me.Name 'y cerramos el de acceso
End If
End If
End Sub

Private Sub CmdCambioContraseña_Click()
On Error GoTo Err_CmdCambioContraseña_Click

If Nz(Me.TxtUsuario, "") = "" Then
MsgBox "Seleccione un empleado de la lista para cambiar su contraseña", vbInformation, "SELECCIONE USUARIO"
Else

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "FormCambioContraseña"

stLinkCriteria = "[IdEmpleado]=" & Me.TxtUsuario

DoCmd.OpenForm stDocName, , , stLinkCriteria
End If

Exit_CmdCambioContraseña_Click:
Exit Sub

Err_CmdCambioContraseña_Click:
MsgBox Err.Description
Resume Exit_CmdCambioContraseña_Click
End Sub

Private Sub CmdCerrar_Click()
On Error GoTo Err_CmdCerrar_Click

'boton salir
DoCmd.Close acForm, Me.Name

Exit_CmdCerrar_Click:
Exit Sub

Err_CmdCerrar_Click:
MsgBox Err.Description
Resume Exit_CmdCerrar_Click

End Sub

Private Sub Detalle_Click()

End Sub

Private Sub Etiqueta0_Click()

End Sub

Private Sub Form_Load()
DoCmd.Restore
NumIntentos = 3
End Sub

Private Sub TxtUsuario_Change()
On Error GoTo Err_TxtUsuario_Change
Me.TxtContraseña.SetFocus


Exit_TxtUsuario_Change:
Exit Sub

Err_TxtUsuario_Change:
'en caso de error, no pasa nada
Resume Exit_TxtUsuario_Change
End Sub

Public Function OcultaTodasTablas()
Dim Tb As TableDef

For Each Tb In CurrentDb.TableDefs
Tb.Attributes = 1

Next
End Function
Public Function MuestraTodasTablas()
Dim Tb As TableDef

For Each Tb In CurrentDb.TableDefs
If Mid(Tb.Name, 1, 4) = "Msys" Then
Else
Tb.Attributes = 0
End If

Next
End Function