[Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

Pessoal esse código em vba gera senhas aleatórias sem repetição de sequências, porém ele reorganiza as mesmas letras em uma nova sequência. Gostaria  de saber se é possível fazer ele gerar sequências sem repetição dos mesmos grupos de letras, afim que seja geradas todas as sequências possíveis sem repetição do mesmo conjunto letras. Ex.: Letras (ABCDEF) Gerar senha com apenas três letras das seis escolhidas (abc, abd, abe, abf... quero poder continuar gerando senhas sem repetir o mesmo grupo de letras. Ex.: (abc) pois da forma que está ele ainda vai aparecer reorganizado diferente (cba, acb...). Quero impedir essa reorganização dos mesmos letras. Obs.: Se for possível essa rotina gostaria de saber o que tenho que alterar no código abaixo.

Option Compare Database

Function GerarSenha()
On Error GoTo TratarErro
Dim TamanhoSenha As Integer, Codigo As String, Novo As String

'--------------------------------------
'CRIA SENHA ALEATÓRIA
'--------------------------------------

Codigo = ""
TamanhoSenha = Nz(Form_SenhaAleatoria.TamanhoSenha,

Dim Letra(22)

Letra(0) = "A "
Letra(1) = "B "
Letra(2) = "C "
Letra(3) = "D "
Letra(4) = "E "
Letra(5) = "F "
Letra(6) = "G "
Letra(7) = "H "
Letra( = "I "
Letra(9) = "J "
Letra(10) = "K "
Letra(11) = "M "
Letra(12) = "N "
Letra(13) = "O "
Letra(14) = "P "
Letra(15) = "Q "
Letra(16) = "R "
Letra(17) = "S "
Letra(18) = "T "
Letra(19) = "U"
Letra(20) = "V "
Letra(21) = "X "
Letra(22) = "Z "

Randomize

Do While Len(Codigo) < TamanhoSenha
   Novo = Letra(Int(22 * Rnd))

   If InStr(1, Codigo, Novo) = 0 Then
       Codigo = Codigo & Novo
   End If

Loop

GerarSenha = Codigo

SairFunction:
Exit Function

TratarErro:
MsgBox "Ocorreu um erro ao processar o comando:" & Chr(13) & Err.Description, vbCritical, " Erro " & Err.Number
Resume SairFunction

End Function

Desde já agradeço!!!

Bom dia,

Como cada letra possui um código específico dentro da matriz e este não vai mudar em momento algum, voce pode gravar numa tabela auxiliar a soma desses códigos e, no momento de gerar o código, fazer uma verificação se a soma dos caracteres gerados pela função já existe nessa tabela, caso exista, o código irá refazer o processo. Como ambas as somas de BC e CB vão dar 3, só a primeira combinação que for gerada entre as duas será gravada na tabela (por exemplo).

------------------------------
EDIT:

Agora que percebi que a matriz está errada. Ela deve ter 23 elementos, e não 22 como no seu código e no exemplo. Do jeito que está, a latra Z está sendo excluída das senhas. Vou consertar apenas aqui no post, lembre de faze-lo no seu programa.

------------------------------

Segue:

Código:

Sub geraSenha()
    Dim tamanhoSenha As Integer
    Dim codigo As Integer
    Dim soma As Integer
    Dim senha As String
    Dim booOk As Boolean
    Dim rs As Recordset
    
    tamanhoSenha = txtTamanhoSenha
    booOk = False
    senha = ""
    codigo = 0
    soma = 0
    
    Dim Letra(23)
    Letra(0) = "A"
    Letra(1) = "B"
    Letra(2) = "C"
    Letra(3) = "D"
    Letra(4) = "E"
    Letra(5) = "F"
    Letra(6) = "G"
    Letra(7) = "H"
    Letra(8) = "I"
    Letra(9) = "J"
    Letra(10) = "K"
    Letra(11) = "M"
    Letra(12) = "N"
    Letra(13) = "O"
    Letra(14) = "P"
    Letra(15) = "Q"
    Letra(16) = "R"
    Letra(17) = "S"
    Letra(18) = "T"
    Letra(19) = "U"
    Letra(20) = "V"
    Letra(21) = "X"
    Letra(22) = "Z"
    
    Do While booOk = False
        Do While Len(senha) < tamanhoSenha
            codigo = Int(Rnd * 23) + 1
            
            If InStr(1, senha, Letra(codigo)) = 0 Then
                soma = soma + codigo
                senha = senha & Letra(codigo)
            End If
        Loop
        
        Set rs = CurrentDb.OpenRecordset("SELECT COUNT(codigo) AS c FROM tblSenhas WHERE soma = " & soma & "")
        
        If rs!c = 0 Then
            booOk = True
            
            Dim rs1 As Recordset
            Set rs1 = CurrentDb.OpenRecordset("tblSenhas")
            rs1.AddNew
                rs1("senha") = senha
                rs1("soma") = soma
            rs1.Update
            rs1.Close
            
            txtSenhaGerada = senha
            
            MsgBox "Senha gravada com sucesso!", vbInformation, "Senha"
            
            txtSenhaGerada = Null
        End If
        
        codigo = 0
        soma = 0
        senha = ""
    Loop
End Sub

Em anexo o modelo que fiz.

Abraço.

Show de Bola!!!!

Muito Obrigado CassioFabre, analisar o fonte que você anexou me ajudou muito a entender onde eu estava errando. Muito Obrigado mesmo!!!!

Cassio

Boa sacada essa da soma dos elementos resultantes.

Gostei!

Parabéns!


[ ]'s

Boa tarde,

Muito obrigado Noobezinho. Já aprendi demais com você!

Abraço.