Login (adaptar código)

Boa tarde a todos,

Tenho um sistema de uso pessoal em Access 2003. Estou tentando adaptar dois códigos muitos bons que encontrei no fórum para adicionar o Login por nivel de usuário. (Siscad (Plinio) e Telemax (Avelino). Estou quase lá.

Quando inclui o usuário ele deverá acrescentar na tabela permissões do usuário os registros da tabela função. Está fazendo normal, só que acrescenta na tabela permissões o ID do usuário 1, ou seja o primeiro da tabela tblUsuários e não o que estou acrescentando. Onde errei?

Abaixo código utilizado no formulário e imagem das tabelas e do formulário.

Agradeço a ajuda de todos.

E aproveito para agradecer ao Plinio e ao Avelino pelos excelentes sistemas disponibilizados.

Menezes

Segue o código

Private Sub BotaoIncluirUsuario_Click()
   Dim rsUsuários As dao.Recordset, rsFunções As dao.Recordset, rsPermissões As dao.Recordset
   Dim filtro As String, mysql As String, bloqueio As Boolean, idc As Long
On Error Resume Next
       
       Dim objUsuario As New classeUsuario
       
       objUsuario.Login = CaixaLogin.Value
       objUsuario.codGrupo = CInt(CaixaGrupo.Value)
       objUsuario.status = "ATIVADO"
       objUsuario.senha = criptografarSenha("123")
       
       If objUsuario.incluir Then
           MsgBox "Usuário incluído com sucesso...", vbInformation, "Inclusão de Usuário"
           SubFCadUsuario.Requery
           
 
   Set rsUsuários = CurrentDb.OpenRecordset("tblUsuario")
   rsUsuários.AddNew
   bloqueio = True
   
   If bloqueio = True Then
   filtro = "Login = '" & Me!CaixaLogin & "' AND codgrupo ='" & Me!CaixaGrupo & "'"
   idc = DLookup("idUsuario", "tblUsuario", filtro)
   Set rsPermissões = CurrentDb.OpenRecordset("tblPermissõesUsuários")
   Set rsFunções = CurrentDb.OpenRecordset("tblFunções")
   rsFunções.MoveFirst
   Do While Not rsFunções.EOF
       rsPermissões.AddNew
           rsPermissões!IdUsuario = idc
           rsPermissões!IdFuncao = rsFunções!IdFuncao
           rsPermissões!Atualizar = -1
           rsPermissões!Inserir = -1
           rsPermissões!Excluir = -1
           rsPermissões!Bloqueada = 0
       rsPermissões.Update
       rsFunções.MoveNext
   Loop
   rsFunções.Close
   rsPermissões.Close
   Set rsFunções = Nothing
   Set rsPermissões = Nothing
End If
   
       Else
           MsgBox "Erro ao incluir Usuário!" & vbCrLf & "Tente novamente...", vbExclamation, "Inclusão de Usuário"
       End If
   
End Sub

Prezados senhores:

Favor remover este tópico, foi em duplicidade e não consegui remove-lo.

Grato e desculpem a falha e o transtorno.

Menezes

Bom dia,
Como este foi o 1º, eliminei o duplicado.