Read Windows Product ID in Vista from Access

[biganthony via AccessMonster.com]

Hello,
I have used the following code to retrieve the Product ID of Windows XP in
Access. However, when the code is run on a Windows Vista Business computer,
it gives me an error: "Could not retrieve the key." It doesn't seem to be
able to read the value. Is there any way to enable this code to work in Vista?
Has the registry structure changed in Vista?

Thanks ,
Anthony

I found the code below originally on this site and it was posted by Graham
Seach in 2004.

Code:
*************************************

Option Compare Database
'Graham R Seach - 05-11-2004.
'from the Access Web.

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
MsgBox "Error " & Err.Number & vbCrLf & _
Err.Description, vbOKOnly + vbExclamation, "Could not retrieve the
key"

Resume Proc_Exit
End Function

************************************************************