Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const READ_CONTROL As Long = &H20000
Public Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Public Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Public Const KEY_NOTIFY As Long = &H10
Public Const SYNCHRONIZE As Long = &H100000
Public Const REG_SZ As Long = 1
Public Const ERROR_SUCCESS As Long = 0&

Public Const KEY_READ As Long = (( _
    STANDARD_RIGHTS_READ _
    Or KEY_QUERY_VALUE _
    Or KEY_ENUMERATE_SUB_KEYS _
    Or KEY_NOTIFY) _
    And (Not SYNCHRONIZE))

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long) As Long
  
Private Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  lpType As Long, _
  lpData As Any, _
  lpcbData As Long) As Long

Private lngReturn As Long

Public Function GetWindowsProductID() As Variant
    Dim lngRootKey As Long
    Dim hKey As Long
    Dim strSubKey As String
    Dim strValueName As String
    Dim strBuffer As String
    Dim lngSize As Long
    
    On Error GoTo Proc_Err
    
    lngRootKey = HKEY_LOCAL_MACHINE
    strSubKey = "Software\Microsoft\Windows\CurrentVersion"
    strValueName = "ProductId"
    
    'Open the key and get its handle
    lngReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strSubKey, _
            0&, KEY_READ, hKey)
    
    'Check that the call succeeded
    If lngReturn <> ERROR_SUCCESS Then
        Err.Raise vbObjectError + 1, , "Could not open key."
    End If
    
    'Initialize the variables
    strBuffer = Space(255)
    lngSize = Len(strBuffer)
    
    'Read the key value
    lngReturn = RegQueryValueEx(hKey, _
                                strValueName, _
                                0&, _
                                REG_SZ, _
                                ByVal strBuffer, _
                                lngSize)
    
    'Check that the call succeeded
    If lngReturn <> ERROR_SUCCESS Then
        Err.Raise vbObjectError + 1, , "Could not read value."
    End If
    
    'Return the key value
    GetWindowsProductID = Left(strBuffer, lngSize - 1)
    
Proc_Exit:
    On Error Resume Next
    'Close the key
    lngReturn = RegCloseKey(hKey)
    Exit Function
    
Proc_Err:
    GetWindowsProductID = Null
    DoCmd.Beep
    MsgBox "Error " & Err.Number & vbCrLf & _
        Err.Description, vbOKOnly + vbExclamation, _
        "Could not retrieve the key"
        
    Resume Proc_Exit
End Function