VBA generating a random unique alpha-numeric string

Question

I need to create a Unique-ID (string) for each record as I am developing an application which allows users to access a unique URL like:

http://URL.com/BXD31F

The code below works to create the URLIDs:

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

How can I ensure that the URLID created is unique? Do I need to query the database to ensure it has not been generated before? The table has 5 million records. A dlookup query would exceed the limitations of my MSAccess database.

I have considered using the timestring to generate the URLID:

 Format(Now, "yymmddhhmmss")

However, I only want a simple 5 character string.

Answer 1

How can I ensure that the URLID created is unique?

You can't. And it won't be. Look into cryptographically secure hashing algorithms... and even those are never "secure" forever. Note, hashing is something for which VBA has absolutely zero built-in support, but you can leverage .NET for that.

Another option could be to get the OS to generate Globally Unique IDentifiers (GUID); these would be unique, ...but much longer than a handful of characters.

Good luck!

Answer 2

Ensuring that a string is unique with VBA could be done somehow differently. E.g., take the date time, which is unique every second and give it:

format(now, "YYMMDDHHNS")

As far as it would be too obvious, consider changing it a bit. E.g., remove a random contant number from the datetime, let's say 181387 (as it is a prime number) and pass convert it to a hex. Then it would be quite ok:

Function UniqueString() As String

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

End Function

The above does not seem to work for 32-bit machines. Thus, you may consider splitting the parts of the date to separate numbers and hex-ing them separately:

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

Just make sure there is at least 1 second before calling the function, calling it in the same time zone. Plus, it is a good idea to think about the daylight saving time in advance. In general, it is not a great idea, there would be quite a lot of problems popping up, but for vba and ms-access it would be ok.

Answer 3

I managed to solve my own problem. We need to check to see if the URLID already exists in the table. The challenge is that the URLID is not written into the table until the query has completely executed. Using 6 of the possible 24 characters will give us about 191 million possibilities (24 to the power of 6). As we only need to create 5 million IDs, there is a small chance for duplicate records.

This is how I did it:

Step 1 - Generate Random a URLID for the 5 million rows using the original code

Step 2 - Identify duplicates and update to null using query below

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

Step 3 - Generate new URLID for the nulls identified in Step 2. This time, checking to see if they already exist in the table. See code below:

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

Function below used to see if URL exists

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

I repeated steps 2 and 3 until there are were no more duplicates. Each time checking against the existence of the already confirmed URLID. Eventually there will be no more duplicate URLIDs.