VBA 生成一个随机的唯一字母数字字符串

Question

我需要为每条记录创建一个唯一 ID（字符串），因为我正在开发一个允许用户访问唯一 URL 的应用程序，例如：

下面的代码用于创建 URLID：

Public Function getURLID(ID As Double) As String

Randomize
Dim rgch As String
rgch = "23456789ABCDEFGHJKLMNPQRSTUVWXYZ"

Dim i As Long
For i = 1 To 5
    getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next

End Function

如何确保创建的 URLID 是唯一的？我是否需要查询数据库以确保之前没有生成过？ table 有 500 万条记录。 dlookup 查询会超出我的 MSAccess 数据库的限制。

我考虑过使用时间字符串生成 URLID:

 Format(Now, "yymmddhhmmss")

但是，我只想要一个简单的5个字符的字符串。

Answer 1

确保字符串与 VBA 的唯一性可以以某种不同的方式完成。例如，取每秒唯一的日期时间并给它：

format(now, "YYMMDDHHNS")

至于太明显，考虑稍微改变一下。例如，从日期时间中删除一个随机常数，假设 181387（因为它是质数）并将其转换为十六进制。那么就可以了:

Function UniqueString() As String

    Const someNumber = 181387 'it is a prime number
    UniqueString = Hex(Format(Now, "YYMMDDHHNS") - someNumber)

End Function

以上似乎不适用于 32 位机器。因此，您可以考虑将日期的各个部分拆分为单独的数字并分别对它们进行十六进制处理：

Function UniqueString32() As String

    Const primeNumber = 23        
    Application.Wait Now + #12:00:02 AM#    'waiting 2 seconds
    UniqueString32 = Hex(Format(Now, "YY")) _
                    & Hex(Format(Now, "MM")) _
                    & Hex(Format(Now, "DD")) _
                    & Hex(Format(Now, "HH")) _
                    & Hex(Format(Now, "NS") - primeNumber)

End Function

只要确保在调用函数之前至少有1秒，在同一时区调用它。另外，提前考虑夏令时是个好主意。一般来说，这不是一个好主意，会弹出很多问题，但对于 vba and ms-access 来说没问题。

Answer 2

How can I ensure that the URLID created is unique?

你不能。它不会。查看加密安全哈希算法...甚至那些永远不会 "secure"。请注意，散列是 VBA 绝对零内置支持的东西，但是 you can leverage .NET for that.

另一种选择是让 OS 生成 Globally Unique IDentifiers (GUID)；这些将是独一无二的，...但比几个字符要长得多。

祝你好运！

Answer 3

我设法解决了自己的问题。我们需要检查 URLID 是否已经存在于 table 中。挑战在于 URLID 在查询完全执行之前不会写入 table。使用可能的 24 个字符中的 6 个将为我们提供大约 1.91 亿种可能性（24 的 6 次方）。由于我们只需要创建500万个ID，重复记录的可能性很小。

我是这样做的：

第 1 步 - 使用原始代码为 500 万行随机生成一个 URLID

第 2 步 - 使用下面的查询识别重复项并更新为 null

 UPDATE URLIDs SET URLIDs.URL = Null
 WHERE (((URLIDs.URL) In (SELECT [URL] FROM [URLIDs] As Tmp GROUP BY [URL] HAVING 
 Count(*)>1 )));

第 3 步 - 为第 2 步中识别的空值生成新的 URLID。这一次，检查它们是否已存在于 table 中。请参阅下面的代码：

Public Function getURLID(roll As Double) As String
Randomize
Dim rgch As String
rgch = "ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim i As Long

For i = 1 To 6
        getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next

Do Until URLIDExists(getURLID) = False
    getURLID = ""

    For i = 1 To 6
        getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
    Next
Loop
End Function

下面的函数用来查看URL是否存在

Public Function URLIDExists(URLID As String) As Boolean
Dim RS1
Dim strQuery As String
strQuery = "SELECT * from [URLIDs] where [URL]='" & URLID & "'"
Set RS1 = CurrentDb.OpenRecordset(strQuery)
If RS1.RecordCount > 0 Then
URLIDExists = True
Else
URLIDExists = False
End If
Set RS1 = Nothing
End Function

我重复了第 2 步和第 3 步，直到不再有重复项。每次检查是否存在已确认的 URLID。最终将不再有重复的 URLID。

VBA 生成一个随机的唯一字母数字字符串

VBA generating a random unique alpha-numeric string

random

vba

uniqueidentifier

ms-access-2016