You can also use the random number generator of the Microsoft Cryptographic Provider. This is said to be even cryptographically random. The code can be added as a class module (or a module).
Option Explicit
Private Const MS_DEF_PROV As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
#If VBA7 Then
Private hProv As LongPtr
Private Declare PtrSafe Function CryptAcquireContext Lib "advapi32" _
Alias "CryptAcquireContextA" (ByRef phProv As LongPtr, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptReleaseContext Lib "advapi32" _
(ByVal phProv As LongPtr, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptGenRandom Lib "advapi32" (ByVal phProv As LongPtr, _
ByVal dwLen As Long, ByRef pbBuffer As Any) As Long
#Else
Private hProv As Long
Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" _
(ByRef phProv As Long, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal phProv As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32" (ByVal phProv As Long, _
ByVal dwLen As Long, ByRef pbBuffer As Any) As Long
#End If
' Call before generating numbers
Public Function CGR_Init() As Boolean
CGR_Init = (CryptAcquireContext(hProv, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, 0) <> 0)
End Function
Public Function CGR_Free()
If hProv <> 0 Then
CryptReleaseContext hProv, 0
hProv = 0
End If
End Function
' Uniform[0, 1)
Public Function CGR_Rnd() As Double
' Only SizeOf(Long) (and not Double) random bytes.
Dim Num As Long
CryptGenRandom hProv, Len(Num), Num
CGR_Rnd = Num / 4294967296# + 0.5
End Function
Bookmarks