Unieke waarde genereren

[johnkolen]

Hallo,

voor een password systeem heb ik een macro welke random wachtwoorden genereert.

Sub NewPass()
Do
If ActiveCell.Offset(0, -1) <> "" Then
ActiveCell.Formula = UCase(Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "000000")) & "-" & UCase(Chr(Int((26 * Rnd) + 97)) & Format(Int(100000000 * Rnd), "000000"))
ActiveCell.Offset(1, 0).Select
Else
Exit Sub
End If
Loop
End Sub


Echter zijn deze niet uniek. Hoe kan ik bovenstaande macro aanpassen zodat een wachtwoord NOOIT
2x gegenereerd kan worden? Ik denk zelf iets met de datum/tijd en dan tot op de micro seconden.
Alleen geen idee hoe dit hierin te verwerken.

Hopelijk kan iemand me op weg helpen met een oplossing.

Mvg,

John

 

[Elsendoorn2134]

John,

Als je rnd gebruikt dan ook eerst even de randomizer functie gebruiken gebruiken:Randomize().
Als je Randomize niet gebruik zal de Rnd funktie (zonder argement) een stuk minder "Random" zijn.
Een wachtwoord NOOIT 2x te genereren is alleen mogelijk als je alle uitgegeven wachtwoorden bij houdt in een tabel
en een controle uitvoert op al uitgegeven.

Veel Succes.

 

[cow18]

Sub NewPass()
  Dim s        As String
  Randomize
  With CreateObject("scripting.dictionary")
    Do                                                     'start loopje
      s = UCase(Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "000000")) & "-" & UCase(Chr(Int((26 * Rnd) + 97)) & Format(Int(100000000 * Rnd), "000000"))  'random string
      If Not .exists(s) Then .Add s, Nothing               'indien die string nog niet in de dictionary staat, dan toevoegen
    Loop While .Count < 1000                               'loopje tot je 1.000 unieke paswoorden hebt
    ActiveCell.Resize(.Count) = WorksheetFunction.Transpose(.keys)  'schrijf ze weg in een kolom vanaf huidig actieve cel
  End With
End Sub

 

[snb]

Waarom niet de inlognaam van de gebruiker gebezigd ?

msgbox createobject("wscript.network").username