Access - Control de acceso

me he bajado un ejemplo de control de acceso, lo que sucede es que este solo oculta las tablas y lo que necesito es que si no es usuario autorizado no me deje entrar al formulario, es mas que me saque de access.
Si alguien me lo puede completar le agradeceria un monton.

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..."
DoCmd.Close acForm, Me.Name 'y cerramos el de acceso
End If

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

MsgBox "Ha entrado el administrador,", vbInformation, "BIENVENIDO ADMINISTRADOR"
Call MuestraTodasTablas
Else
MsgBox "Buen dia, Bienvenido", 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

Private Sub Form_Close()
MsgBox " Un Placer servirle ", vbInformation, "esparta"
End Sub