Случайный буквенно-цифровой генератор с уникальным валидатором, возвращающий дополнительные цифры при обнаружении уникальных конфликтов - PullRequest
0 голосов
/ 18 октября 2018

Я использую этот код для вызова случайной буквенно-цифровой строки.Я делаю это через текстовое поле в форме доступа.

https://www.devhut.net/2010/06/22/ms-access-vba-generate-a-random-string/

Я пытаюсь заставить его также проверить его уникальность в столбце в Access.Когда это терпит неудачу, это должно бежать снова.Тем не менее, эта проблема решается путем удвоения генерируемых цифр.Например, чтобы проверить это, я запускаю его на поле, заполненном записями от 01 до 98.Он должен генерировать только двузначную числовую строку, но возвращает 4 цифры.

Кстати, я не кодер и очень незнаком с VB.Я просто срываю код с интернета и молюсь, чтобы он работал.Поэтому я могу не понять, когда вы ответите.

Function GenRandomStr(iNoChars As Integer, _
                  bNumeric As Boolean, _
                  bUpperAlpha As Boolean, _
                  bLowerAlpha As Boolean)
On Error GoTo Error_Handler
Dim AllowedChars()        As Variant
Dim iNoAllowedChars       As Long
Dim iEleCounter           As Long
Dim i                     As Integer
Dim iRndChar              As Integer

Dim varCountOfResults As Integer

varCountOfResults = 1

While varCountOfResults > 0

'Initialize our array, otherwise it throws an error
ReDim Preserve AllowedChars(0)
AllowedChars(0) = ""

'Build our list of acceptable characters to use to generate a string from
'Numeric -> 48-57
If bNumeric = True Then
    For i = 48 To 57
        iEleCounter = UBound(AllowedChars)
        ReDim Preserve AllowedChars(iEleCounter + 1)
        AllowedChars(iEleCounter + 1) = i
    Next i
End If
'Uppercase alphabet -> 65-90
If bUpperAlpha = True Then
    For i = 65 To 90
        ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
        iEleCounter = UBound(AllowedChars)
        AllowedChars(iEleCounter) = i
    Next i
End If
'Lowercase alphabet -> 97-122
If bLowerAlpha = True Then
    For i = 97 To 122
        ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
        iEleCounter = UBound(AllowedChars)
        AllowedChars(iEleCounter) = i
    Next i
End If

'Build the random string
iNoAllowedChars = UBound(AllowedChars)
For i = 1 To iNoChars
    Randomize
    iRndChar = Int((iNoAllowedChars * rnd) + 1)
    GenRandomStr = GenRandomStr & Chr(AllowedChars(iRndChar))
Next i

varCountOfResults = DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'")


Wend

Error_Handler_Exit:
On Error Resume Next
Exit Function

Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
       "Error Number: " & Err.Number & vbCrLf & _
       "Error Source: GenRandomStr" & vbCrLf & _
       "Error Description: " & Err.Description & _
       Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
       , vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

1 Ответ

0 голосов
/ 18 октября 2018

Вам нужно добавить GenRandomStr = "" в верхней части цикла, в противном случае второй / третий проход просто добавит к существующей строке.

Рефакторинг немного и не проверен, потому что у меня нет доступа:

Function GenRandomStr(iNoChars As Integer, _
                  bNumeric As Boolean, _
                  bUpperAlpha As Boolean, _
                  bLowerAlpha As Boolean)


    Dim AllowedChars As String, iEleCounter As Long
    Dim i As Long, iRndChar As Long, iNoAllowedChars As Long

    If bNumeric Then AllowedChars = "0123456789"
    If bUpperAlpha Then AllowedChars = AllowedChars & "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    If bLowerAlpha Then AllowedChars = AllowedChars & "abcdefghijklmnopqrstuvwxyz"

    iNoAllowedChars = Len(AllowedChars)
    Do
        GenRandomStr = ""
        For i = 1 To iNoChars
            Randomize
            iRndChar = Int((iNoAllowedChars * Rnd) + 1)
            GenRandomStr = GenRandomStr & Mid(AllowedChars, iRndChar, 1)
        Next i
        Exit Do
    Loop While DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'") > 0

End Function
...