Login con limitador de intentos funciona pero...

A Sveinbjorn El Rojo el cual me ayudo en esto y le esto muy agradecido.

Private Sub cmdAceptar_Click()
'Requiere registro de la librería "Microsoft DAO 3.6 Object Library" o
'módulo equivalente
'Declaramos las variables
Const numIntentos As Byte = 3 'Aquí definimos el número de intentos que queremos permitir
Dim vUser As Variant
Dim vPass As Variant
Dim tUser As String, tPass As String
Dim rst As Recordset
'Cogemos el valor del usuario
vUser = Me.cboUser.Value
'Cogemos el valor de la contraseña
vPass = Me.txtPass.Value
'Si no hay usuario avisamos y salimos
If IsNull(vUser) Then
MsgBox "No ha seleccionado ningún usuario", vbInformation, "AVISO"
Me.cboUser.SetFocus
Exit Sub
End If
'Si no hay contraseña avisamos y salimos
If IsNull(vPass) Then
MsgBox "No ha introducido ninguna contraseña", vbInformation, "AVISO"
Me.txtPass.SetFocus
Exit Sub
End If
'Creamos un recordset sobre la tabla TPass
Set rst = CurrentDb.OpenRecordset("TPass", dbOpenSnapshot)
'Si no hay registros avisamos y saltamos a Salida
If rst.RecordCount = 0 Then
MsgBox "No existen usuarios", vbInformation, "AVISO"
GoTo Salida
End If
'Nos movemos al primer registro e iniciamos el recorrido de registros
rst.MoveFirst
Do Until rst.EOF
'Cogemos los valores de usuario y pass de la tabla
tUser = rst.Fields(0).Value
tPass = rst.Fields(1).Value
'Si coinciden damos entrada a la BD
If tUser = vUser Then
If tPass = vPass Then
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "FMenu"
'Si no coinciden...
Else
'Miramos en qué número de intento estamos, que nos viene dado por
'el valor de txtContador
If Me.txtContador.Value = numIntentos Then
'Si hemos superado el número de intentos decimos adiós al usuario
MsgBox "Ha superado el número de intentos. La aplicación se cerrará", vbCritical, "CERRAR"
DoCmd.Quit
Else
'Si aún no ha superado el número de intentos dejamos que lo pruebe de nuevo
MsgBox "La contraseña introducida no es correcta." & vbCrLf & vbCrLf & _
"Dispone de " & numIntentos - Me.txtContador.Value & _
IIf(numIntentos - Me.txtContador.Value = 1, " intento más", " intentos más"), _
vbInformation, "INCORRECTO"
Me.txtPass.SetFocus
Me.txtPass.Value = Null
'Añadimos una unidad al valor de txtContador
Me.txtContador.Value = Me.txtContador.Value + 1
GoTo Salida
End If
End If
End If
'Nos movemos al siguiente registro
rst.MoveNext
Loop
Salida:
'Cerramos conexiones y liberamos memoria
rst.Close
Set rst = Nothing
End Sub

Pero me explico, el formulario que tengo es de pagos IVA los cuales tengo un Menú, donde selecciono por años, de esté entro en consulta, donde puedo consultar los datos, y de esté entro en Edita por si tengo que Editar dichos datos para entrar en Edita se abre el FPass que es esté

con la instrucción en el botón aceptar

Private Sub cmdAceptar_Click()
Dim vUser As Variant
Dim vPass As Variant
vUser = Me.cboUser.Value
vPass = Me.txtPass.Value
If IsNull(vUser) Then
MsgBox "No ha seleccionado ningún usuario", vbInformation, "AVISO"
Me.cboUser.SetFocus
Exit Sub
End If
If IsNull(vPass) Then
MsgBox "No ha introducido ninguna contraseña", vbInformation, "AVISO"
Me.txtPass.SetFocus
Exit Sub
End If
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("TPass", dbOpenSnapshot)
If rst.RecordCount = 0 Then
MsgBox "No existen usuarios", vbInformation, "AVISO"
GoTo Salida
End If
rst.MoveFirst
Do Until rst.EOF
Dim tUser, tPass As String
tUser = rst.Fields(0).Value
tPass = rst.Fields(1).Value
If tUser = vUser Then
If tPass = vPass Then
'DoCmd.Close acForm, Me.Name
If VarType(IdIVA) <> vbNull Then
DoCmd.OpenForm "IVAEdita", , , "[IdIVA] = " & Me.IdIVA
DoCmd.Close acForm, "IVAConsulta"
DoCmd.Close acForm, "FPass"
End If
Else
MsgBox "La contraseña introducida no es correcta", _
vbInformation, "INCORRECTO"
Me.txtPass.SetFocus
Me.txtPass.Value = Null
GoTo Salida
End If
End If
rst.MoveNext
Loop

Salida:
rst.Close
Set rst = Nothing
End Sub

Y funcionaba perfecto, pero si la cambio por la del contador me abre por el primer registro que se encuentra, la cuestión que cambias debo hacer para que habrá por el id que le pido.