White Tiger

Microsoft Access VBA - WidnowsのProduct IDを表示する方法

文書番号: ac2002010
動作確認: Access 95/97/2002

◆概要
この資料は、Microsoft AccessでWidnowsのProduct IDを表示する方法を記載しています。

◆内容

コントロールパネルのシステムを選択すると、Windows のプロダクトＩＤが表示されます。このProduct IDはレジストリに記録されていますので、これを取得すればAccessのフォームにWindows Product IDを表示できます。

◆Sample code

標準モジュールに以下のコードを貼り付けます。

Option Compare Database

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1&
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
    KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const VER_PLATFORM_WIN32_NT = 2

'APIの宣言
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
    ByVal hkeyRoot As Long, _
    ByVal lpszSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkeyResult As Long _
    ) As Long

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

Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long

'構造体
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Function GetWinProductId() As String
    Dim stSubKey As String
    Dim stProductid As String * 255
    Dim hkeyRoot As Long
    Dim lErr As Long
    Dim OSVER As OSVERSIONINFO
    
    OSVER.dwOSVersionInfoSize = Len(OSVER)
    lErr = GetVersionEx(OSVER)
    If lErr = 0 Then Exit Function
        
    If OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        stSubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
    Else
        stSubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion"
    End If
        
    lErr = RegOpenKeyEx(HKEY_LOCAL_MACHINE, stSubKey, 0&, KEY_READ, hkeyRoot)
    If lErr <> 0 Then Exit Function
    
    lErr = RegQueryValueEx(hkeyRoot, "ProductId", 0&, REG_SZ, _
                                        ByVal stProductid, 255)
    Err = RegCloseKey(hkeyRoot)
    If lErr <> 0 Then Exit Function
    
    GetWinProductId = Left(stProductid, InStr(stProductid, vbNullChar))
End Function

次に適当なフォームにテキストボックスを貼り付け、そのコントロールソースに

=GetWinProductId()

◆実行結果

Link