Public Function szMakeMyRef(ByRef nIterations As Integer, Optional bRecursiveCall As Boolean = False) As String
Dim nCounter As Integer
Dim szChr As String
Dim szBuild As String
Dim bUsed As Boolean
Static nRecursionCounter As Integer
If bRecursiveCall Then
nRecursionCounter = nRecursionCounter + 1
Else
nRecursionCounter = 0
End If
Randomize
nCounter = 1
'They will usualy begin with "D"
'If it takes more than 1000 attempts to make a unique ref starting with D,
'try one starting with X - plus generate a message to users to alert me this is happening so I can come up with a plan to do something about it - e.g. purge old records. - then move on to I.
Select Case nRecursionCounter
Case 0 To 1000
szBuild = "D" 'D is the Default First Character
Case 1001 To 2000
szBuild = "X" ' X for getting eXtremely hard to generate
Case 2001 To 3000
szBuild = "I" ' I for Impossible to generate !
'More than 3000 calls will soon eventuate in out of stack space !
Case Is > 3000
Err.Raise vbObjectError + 1001, "szMakeMyRef!Recursion", "Unique Reference too hard to generate"
End Select
Do While nCounter < 5
If Int((0 - -1 + 1) * Rnd + -1) Then ' random true or false
'a letter please
'Upper Case please
szChr = Chr$(Int((90 - 65 + 1) * Rnd + 65))
Else
'a number please (excluding zero)
szChr = Chr$(Int((57 - 49 + 1) * Rnd + 49))
End If
'exclude zero, one, O, I , l , S etc
'These characters are eassily confused with other characters
'Only need to exclude upper case, as lower case posibility deleted.
Select Case szChr
Case "0", "O", "1", "I", "L", "B", "8", "S", "5", "2", "Z", "7", "Q", "U", "J", "D"
'don't use
'Still allows for (20^4)*3 (480,000) combinations, (i.e. 160,000 for each of D, X and I)
Case Else
szBuild = szBuild & szChr
nCounter = nCounter + 1
End Select
Loop
'Check to ensure unique (this random sequence not already used)
bUsed = Not IsNull(DLookup("[MyRef]", "tblMyTableName", "[MyRef] = '" & szBuild & "'"))
If Not bUsed Then
szMakeMyRef = szBuild
nIterations = nRecursionCounter
Else
If nRecursionCounter = 750 Then
MsgBox "Reference Numbers may be getting difficult to generate.", vbOKOnly + vbInformation, "Please Advise Support"
ElseIf nRecursionCounter = 1001 Then
MsgBox "Reference Numbers are getting quite difficult to generate.", vbOKOnly + vbExclamation, "Please Advise Support"
ElseIf nRecursionCounter = 2001 Then
MsgBox "Reference Numbers are getting almost IMPOSSIBLE to generate.", vbOKOnly + vbCritical, "Please Advise Support"
End If
szMakeMyRef = szMakeMyRef(nIterations, True)
End If
End Function
