[VB] レジストリを参照する | Archive Redo Blog

Archive Redo Blog

DBエンジニアのあれこれ備忘録

VBA から Java のクラスを呼び出すようなプログラムを組みました。

呼び出す Java のクラス(jarファイル)は J2SE 5.0 で作成したものです。

ゆえに、J2SE Runtime Environment 5.0 の java.exe を起動しなければなりません。

しかし、パスを指定せずに java.exe を起動した場合、他のバージョンの java.exe が起動し、java.lang.UnsupportedClassVersionError などが発生し、処理が失敗してしまう可能性があります。

そのため、J2SE Runtime Environment 5.0 の java.exe を決め撃ちで起動したいのですが、そのインストール場所は環境によって異なります。

確実にインストール場所を突き止め、java.exe を補足するにはどうすればいいか...どうやらレジストリに頼るしかないようです。

J2SE Runtime Environment 5.0 のインストール場所は HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Runtime Environment\1.5 の JavaHome に格納されています。

このキーの値で示されるディレクトリの直下の BIN ディレクトリに java.exe は存在するはずです。


では、VB や VBA でレジストリから特定のキーの値を取得するにはどうすればいいのか...

どうやら そのための API(advapi32.dll)が提供されているようです。
Microsoft のナレッジベースにその方法についての解説がありました。

操作方法使用レジストリ設定を保存してそして取得する API

(自動翻訳のためか、意味不明な日本語タイトルになっています^^;)


上記の解説で挙げられているサンプルコードをほとんど丸々流用しただけですが、一応、値の取得だけに絞込み、使いやすいように若干のアレンジを加えたものが以下のコードになります。

    Option Explicit

    Public Const REG_SZ As Long = 1
    Public Const REG_DWORD As Long = 4

    Public Const HKEY_CLASSES_ROOT = &H80000000
    Public Const HKEY_CURRENT_USER = &H80000001
    Public Const HKEY_LOCAL_MACHINE = &H80000002
    Public Const HKEY_USERS = &H80000003

    Public Const ERROR_NONE = 0
    Public Const ERROR_BADDB = 1
    Public Const ERROR_BADKEY = 2
    Public Const ERROR_CANTOPEN = 3
    Public Const ERROR_CANTREAD = 4
    Public Const ERROR_CANTWRITE = 5
    Public Const ERROR_OUTOFMEMORY = 6
    Public Const ERROR_ARENA_TRASHED = 7
    Public Const ERROR_ACCESS_DENIED = 8
    Public Const ERROR_INVALID_PARAMETERS = 87
    Public Const ERROR_NO_MORE_ITEMS = 259

    Public Const KEY_QUERY_VALUE = &H1
    Public Const KEY_SET_VALUE = &H2
    Public Const KEY_ALL_ACCESS = &H3F

    Public Const REG_OPTION_NON_VOLATILE = 0

    Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As Long _
    ) As Long
    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
    Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As String, _
        lpcbData As Long _
    ) As Long
    Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Long, _
        lpcbData As Long _
    ) As Long
    Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As Long, _
        lpcbData As Long _
    ) As Long

Function QueryValue(hKey As Long, sKeyName As String, sValueName As String) As Variant

    Dim lRetVal As Long        'result of the API functions

    lRetVal = RegOpenKeyEx(hKey, sKeyName, 0, KEY_QUERY_VALUE, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, QueryValue)
    RegCloseKey (hKey)

End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
            sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
            lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select

QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit

End Function

このようなファンクションや定数を定義しておくと、あとは以下のサンプルコードのようにキーを引数にQueryValueというファンクションをコールして値を取得することができるというわけです。

Sub main()
    
    Dim javaHome As Variant
    
    javaHome = QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\JavaSoft\Java Runtime Environment\1.5", "JavaHome")
    If javaHome = "" Then
        MsgBox "Java Runtime Environment 5.0 Not Found", vbCritical, "Error"
    Else
        MsgBox javaHome
    End If

End Sub
レジストリを参照するなんて、できればやりたくはないですが、どうしてもやらざるを得ない場合はこんな感じで...