Autenticação por Contra-senha, aleatoria a cada abertura do Formulário (Semelhante ao dos Bancos)

Tópico que originou a solução:
http://maximoaccess.forumeiros.com/t12649-sistema-de-autenticacao-de-usuarios

1 - Criado a tabela tblCliente com os campos: ID_Cliente, CpSenha
2 - Criado a tabela tblPosicoes com os campo ID_Pos, Cliente_ID, CpPosicao, CpContraSenha
no campo posicao serão numerados de 1 a 70 e no cpContraSenha serão adicionados as mesmas

3 - Criado um formulário para gerar as contra-senhas do cliente (Formulário GeraPosicoes)
Selecione um cliente e clique em gerar, serão gerados 70 registros para o cliente com as contra-senhas em suas devidas posições
Este código criará 70 loops inserindo os 70 registros para o cliente, a cada loop será chamada a função GeraNumero, gerando assim a contra senha
Código:

Private Sub btnGerar_Click()
Dim X As Integer
Dim ContraSenha As String
For X = 1 To 70
ContraSenha = GeraNumero
    CurrentDb.Execute "INSERT INTO TblPosicoes (Cliente_ID, CpPosicao,CpContraSenha) Values (""" & Me.cboCliente.Column(0) & """, """ & X & """, """ & GeraNumero & """) "
Next X
MsgBox "Contra-Senhas geradas com Sucesso!", vbInformation, "GERADO A CONTRA-SENHA"
End Sub

Function GeraNumero()
alfanumerico = "ABCDEFGHIJKLMNOPQRSTUVXZYW1234567890abcdefghijklmnopqrstuvxzyw"
For I = 1 To 3
Randomize
X = Int(Rnd * Len(alfanumerico)) + 1
If InStr(1, Sequencia, Mid(alfanumerico, X, 1)) Then
I = I - 1
Else
Sequencia = Sequencia & Mid(alfanumerico, X, 1)
End If
Next
GeraNumero = Sequencia
End Function

4 - No formulário AutenticacaoDoUsuario, ao ser aberto chama a função GeraNumero que gerará 2 numeros referente a posição, esta posição será aleatória e será sempre diferente a cada abertura, observe que no final do código coloco uma condição para que se o primeiro número da posição for 8 ou 9 reinicia a função para assim gerar números de 01 a 70

Private Sub Form_Load()
Me.Posicao = GeraNumero
End Sub
Function GeraNumero()
alfanumerico = "1234567890"
Continuar:
For I = 1 To 2
Randomize
X = Int(Rnd * Len(alfanumerico)) + 1
If InStr(1, Sequencia, Mid(alfanumerico, X, 1)) Then
I = I - 1
Else
Sequencia = Sequencia & Mid(alfanumerico, X, 1)
If Left(Sequencia, 1) = 9 Or Left(Sequencia, 1) = 8 Then GoTo Continuar
If Left(Sequencia, 1) = 7 And Left(Sequencia, 2) > 0 Then GoTo Continuar

End If
Next
GeraNumero = Sequencia
End Function

5 - No botão entrar carrego um recordset filtrado pelo cliente e posição, e faço a comparação da contra senha digitada na caixa texto txtPosicão
Foi adicionado o tratamento de erros para o erro 3075 caso não seja selecionado um cliente na combo

Private Sub Entrar_Click()
On Error GoTo TrataErro
Dim Rs As Dao.Recordset
    StrSQL = "SELECT * From tblPosicoes WHERE Cliente_ID = " & Me.cboLogin.Column(0) & " And CpPosicao = " & Me.Posicao & ";"
    Set Rs = CurrentDb.OpenRecordset(StrSQL)
   
  If Rs(3) = Me.txtPosicao Then
      MsgBox "A posicão  " & Me.Posicao & "  é a  " & Rs(3) & " e confere com a contra-senha informada", vbInformation, "CONFIRMADO"
  Else
      MsgBox "A contra-senha não confere", vbCritical, "Contra-Senha não confere"
  End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
Exit Sub
TrataErro:
    Select Case Err.Number
        Case 3075
            MsgBox "Selecione um Cliente para efetuar a entrada", vbCritical, "NEGADO"
            Exit Sub
        Case Else
            DoCmd.Hourglass False
            DoCmd.Echo True
                MsgBox "Erro Gerado no :" & Me.Name & " (Login)" _
                & vbNewLine & "Erro Número: " & Err.Number _
                & vbNewLine & "linha: " & Erl _
                & vbNewLine & "Descrição: " & Err.Description _
                & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, Err.Number & ", linha:" & Erl
    End Select
End Sub

Enjoy!!!

*****************************************************************************************************************



Repositório de Exemplos Ms AccessSala destinada à colocação de exemplos em Ms Access (Código aberto) de e para
todos os Utilizadores Cadastrados.
Não tirar duvidas nesta sala.

Grande Harysohn muito bem feito parabéns meu amigo!

Vale lembrar que neste exemplo o login não está implementado, apenas as letras de contra-senha... O login pode ser adicionado a contento de acordo com os diversos exemplos contidos aqui no repositório.

Cumprimentos.