[Resolvido]Erro no codigo LOGIN

Bom dia a todos,

Gostaria que me ajudassem num pequeno ou grande problema.
Tenho uma BD onde adaptei o Código abaixo para uma tela de login e de alterações de registo, mas o que se passa é
que tenho a BD em rede e como é usada por varios utilizadores, fiz o link as tabelas e agora não funciona.
Ajudem por favor só me falta esse pekeno pormenor para o por a trabalhar.
A partir do "With rs" ele trava, se eu comentar ele ja nao trava, mas só me assume o primeiro utilizador da tabela e nao faz a procura..


obrigado

Private Sub cmdLogin_Click()
'By JPAULO
Dim rs As dao.Recordset 'Habilite o DAO nas referencias

Dim myDB As dao.Database
Dim myQDEF As dao.QueryDef
Dim myRST As dao.Recordset
Dim strSQL As String
blnPasswordOK = False

Me.txtAttempts.Enabled = False

If IsNull(Me.txtLoginID) Or Me.txtLoginID = "" Then
MsgBox "Digite o utilizador...", vbInformation, "Info"
Me.txtLoginID.SetFocus
Exit Sub
End If

If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
MsgBox "Digite a password...", vbInformation, "Info"
Me.txtPassword.SetFocus
Exit Sub
End If

strSQL = "SELECT strUserID, strPassword " & _
"FROM tblUsers " & _
"WHERE strUserID=" & """" & Me.txtLoginID & """" & ";"

Set myDB = CurrentDb

Set myQDEF = myDB.CreateQueryDef("")
With myQDEF
.SQL = strSQL
Set myRST = .OpenRecordset()
End With

blnUserFound = Not (myRST.BOF And myRST.EOF)

If blnUserFound Then
blnPasswordOK = (Me.txtPassword = myRST.Fields("strPassword"))
If blnPasswordOK Then
Set rs = CurrentDb.OpenRecordset("tblUsers")
With rs
'rs.Index = Me.txtLoginID '"Primarykey" nome do indice do campo user
'rs.Seek "=", Me.txtLoginID
'rs.Edit
'rs("strDataHora") = Now()
'rs.Update 'Salva
End With
DoCmd.Close
DoCmd.OpenForm "indice", acNormal, "", "", , acNormal
Exit Sub
Else
MsgBox "Password incorrecta...", vbCritical, "Info"
Me.txtPassword = ""
Me.txtPassword.SetFocus
Me.txtAttempts = Me.txtAttempts + 1
End If
Else
MsgBox "Utilizador não Existe...", vbCritical, "Info"
Me.txtLoginID = ""
Me.txtPassword = ""
Me.txtLoginID.SetFocus
Me.txtAttempts = Me.txtAttempts + 1
End If

Me.txtAttempts.Visible = (Me.txtAttempts > 0)

Me.Repaint

bln5attempts = (Me.txtAttempts >= 3)
If bln5attempts Then
MsgBox "Esgotadas as 3 tentativas possiveis!!", vbCritical, "Info"
blnPasswordOK = True
DoCmd.Quit acQuitSaveAll
Exit Sub
End If

myRST.Close
myQDEF.Close
myDB.Close

End Sub

bom dia,

Desculpem mas no codigo que eu tinha postado e no sitio onde ele trava, tinha feito algumas alterações para ver se funfava
mas sem sucesso. O codigo original estava assim:
With rs
'rs.Index = "Primarykey" 'nome do indice do campo user
'rs.Seek "=", Me.txtLoginID
'rs.Edit
'rs("strDataHora") = Now()
'rs.Update 'Salva
End With

Será que o meu problema é por ter as tabelas ligadas????

Faça por favor o teste assim;

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblUsers WHERE ID=" & Me.txtLoginID & "")
   With rs
       rs.Edit
       rs!strDataHora = Now()
       rs.Update
   End With

Ou

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblUsers WHERE ID=" & Me.txtLoginID & "")

If rs.RecordCount > 0 Then
   rs.MoveFirst
Do Until rs.EOF
       rs.Edit
       rs!strDataHora = Now()
       rs.Update
       rs.MoveNext
Loop
End If
Set rs = Nothing

Boa tarde, JPAULO

experimentei e nada, esbarou novamente.

If blnUserFound Then
blnPasswordOK = (Me.txtPassword = myRST.Fields("strPassword"))
If blnPasswordOK Then
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblUsers WHERE ID=" & Me.txtLoginID & "")
With rs
rs.Edit
rs!strDataHora = Now()
rs.Update
End With

esse problema esta relacionado com o facto de estarem as tabelas em rede?

Run time error 3061
too few parameters. Expected 2.

Com os dois expemplos que me deu o erro é o mesmo.

Você quer anexar aqui parte do seu banco ?

Boa tarde JPAULO,

Em anexo está a BD mas sem as tabelas, não ligue muito a estrutura e a confusão dos códigos.  

Desde já um obg por disponibilizar um tempito.

Teste por favor;

Código:

Private Sub cmdLogin_Click()
'By JPAULO
Dim rs As dao.Recordset 'Habilite o DAO nas referencias


    Dim myDB As dao.Database
    Dim myQDEF As dao.QueryDef
    Dim myRST As dao.Recordset
    Dim strSQL As String
    blnPasswordOK = False

    Me.txtAttempts.Enabled = False

    If IsNull(Me.txtLoginID) Or Me.txtLoginID = "" Then
        MsgBox "Digite o utilizador...", vbInformation, "Info"
        Me.txtLoginID.SetFocus
        Exit Sub
    End If

    If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
        MsgBox "Digite a password...", vbInformation, "Info"
        Me.txtPassword.SetFocus
        Exit Sub
    End If

    strSQL = "SELECT strUserID, strPassword " & _
            "FROM tblUsers " & _
            "WHERE strUserID=" & """" & Me.txtLoginID & """" & ";"

    Set myDB = CurrentDb

    Set myQDEF = myDB.CreateQueryDef("")
    With myQDEF
        .SQL = strSQL
        Set myRST = .OpenRecordset()
    End With

    blnUserFound = Not (myRST.BOF And myRST.EOF)

    If blnUserFound Then
        blnPasswordOK = (Me.txtPassword = myRST.Fields("strPassword"))
        If blnPasswordOK Then
     
       
        Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblUsers WHERE strUserID='" & Me.txtLoginID & "'")

If rs.RecordCount > 0 Then
  rs.MoveLast
  rs.MoveFirst
Do Until rs.EOF
      rs.Edit
      rs!strDataHora = Now()
      rs.Update
      rs.MoveNext
Loop
End If
                 
        DoCmd.Close
            DoCmd.OpenForm "indice", acNormal, "", "", , acNormal
            Exit Sub
        Else
            MsgBox "Password incorrecta...", vbCritical, "Info"
            Me.txtPassword = ""
            Me.txtPassword.SetFocus
            Me.txtAttempts = Me.txtAttempts + 1
        End If
    Else
        MsgBox "Utilizador não Existe...", vbCritical, "Info"
        Me.txtLoginID = ""
        Me.txtPassword = ""
        Me.txtLoginID.SetFocus
        Me.txtAttempts = Me.txtAttempts + 1
    End If

    Me.txtAttempts.Visible = (Me.txtAttempts > 0)
   
    Me.Repaint

    bln5attempts = (Me.txtAttempts >= 3)
    If bln5attempts Then
        MsgBox "Esgotadas as 3 tentativas possiveis!!", vbCritical, "Info"
        blnPasswordOK = True
        DoCmd.Quit acQuitSaveAll
        Exit Sub
    End If
Set rs = Nothing
    myRST.Close
    myQDEF.Close
    myDB.Close
End Sub

Bom Dia JPAULO,

Já testei e está a funfar....     
Obrigado pelo tempo disponibilizado....
Quem sabe..sabe.



Um muito obrigado.   

Obrigado pelo retorno o forum agradece.