具有唯一验证器的随机字母数字生成器在发现唯一冲突时返回额外数字

Question

我正在使用此代码调用随机字母数字字符串。我通过访问表单中的文本框这样做。

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

我试图让它也验证它在 Access 中的列中的唯一性。当它失败时，它应该再次运行。但是，它通过将生成的数字加倍来解决该问题。例如，为了对此进行测试，我运行在填充了 01-98 条目的字段上对其进行了测试。它应该只生成一个两位数的数字字符串，但它 returns 一个 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

Answer 1

您需要在循环的顶部添加 GenRandomStr = ""，否则 second/third 遍历只会添加到现有字符串中。

由于我没有访问权限，因此进行了一些重构且未经测试：

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

具有唯一验证器的随机字母数字生成器在发现唯一冲突时返回额外数字

Random alphanumeric generator with unique validator returning extra digits when finding unique conflicts

ms-access

vba

ms-access-2016