VBAでレジストリを安全に操作する: RegOpenKeyExとWin32 API活用術

Tech

本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。

VBAでレジストリを安全に操作する: RegOpenKeyExとWin32 API活用術

背景と要件

Microsoft Officeアプリケーション（ExcelやAccessなど）をVBAで自動化する際、アプリケーションの設定やユーザー固有の情報をWindowsレジストリに保存・読み込みたい場合があります。例えば、データベース接続文字列、アプリケーションの初期設定値、直近のファイルパスなどをレジストリに格納することで、VBAプロジェクトの永続性やポータビリティを向上させることができます。

VBAからレジストリを操作する方法として、WScript.Shellオブジェクトを利用する手軽な方法もありますが、この方法はCOMオブジェクトのインスタンス化が必要であり、特定の環境でのセキュリティ制限やパフォーマンスのオーバーヘッドが発生する可能性があります。また、より低レベルで柔軟な操作や、特定のデータ型（例：REG_DWORD）の確実な操作が必要な場合には、Windows API（Win32 API）を直接利用するのが最適です。

本稿では、VBAからWin32 APIであるRegOpenKeyEx、RegQueryValueEx、RegSetValueEx、RegCloseKey関数をDeclare PtrSafeキーワードを用いて安全に宣言し、レジストリの読み書きを行う具体的な方法を解説します。特に、64ビット版Office環境への対応を考慮し、LongPtr型を使用した宣言を行います。外部ライブラリは一切使用せず、Win32 APIのみで完結させることを要件とします。

設計

1. Win32 API関数の宣言

VBAからWin32 APIを使用するためには、各API関数をDeclare PtrSafeキーワードを用いてモジュールレベルで宣言する必要があります。PtrSafeは、32ビット版と64ビット版のVBA環境の両方でポインター（ハンドル）のサイズを適切に扱うために不可欠です。

  • RegOpenKeyExA: レジストリキーを開きます。

  • RegQueryValueExA: 開いたキーから値を取得します。

  • RegSetValueExA: 開いたキーに値を設定します。

  • RegCloseKey: 開いたレジストリキーを閉じます。

2. 必要な定数の定義

レジストリ操作には、ルートキー（HKEY_CURRENT_USERなど）やアクセス権限（KEY_READ、KEY_WRITEなど）、値のデータ型（REG_SZ、REG_DWORDなど）を示す定数が必要です。これらもモジュールレベルで定義します。

3. レジストリ操作の基本的な流れ

レジストリの読み書きは、以下のステップで構成されます。

  1. キーのオープン: RegOpenKeyExで目的のレジストリキーを開き、ハンドルを取得します。

  2. 値の操作:

    • 読み取り: RegQueryValueExで指定された値の名前と型に対応するデータを読み込みます。

    • 書き込み: RegSetValueExで指定された値の名前、型、データを書き込みます。

  3. キーのクローズ: RegCloseKeyで開いたレジストリキーのハンドルを閉じます。これは非常に重要で、リソースリークを防ぎます。

4. エラーハンドリング

Win32 API関数は、成功時にERROR_SUCCESS（0）を返し、失敗時にはエラーコードを返します。この戻り値をチェックすることで、適切なエラーハンドリングを実装します。

5. 処理フロー図

レジストリ値の読み取り・書き込みのプロセスを以下に示します。

graph TD
    A["開始"] --> B{"レジストリキーパスと値名、操作内容指定"};

    subgraph レジストリ値の読み取り
        B --|読み取り| --> C1{"RegOpenKeyExでキーを開く"};
        C1 --|成功| --> D1{"RegQueryValueExで値を読み取る"};
        C1 --|失敗 (キーなし)| --> E1["エラー処理"];
        D1 --|成功| --> F1{"RegCloseKeyでキーを閉じる"};
        D1 --|失敗 (値なし/権限)| --> E1;
        F1 --> G["結果を返す"];
    end

    subgraph レジストリ値の書き込み
        B --|書き込み| --> C2{"RegCreateKeyEx/RegOpenKeyExでキーを開く/作成"};
        C2 --|成功| --> D2{"RegSetValueExで値を書き込む"};
        C2 --|失敗| --> E2["エラー処理"];
        D2 --> F2{"RegCloseKeyでキーを閉じる"};
        F2 --> G;
    end

    E1 --> H["終了 (エラー)"];
    E2 --> H;
    G --> H;

実装

以下のVBAコードは、レジストリの読み書きを行うためのモジュールです。ExcelまたはAccessの標準モジュールに貼り付けて使用できます。

'---------------------------------------------------------------------------------------------------
' モジュール名: modRegistry
' 目的: Win32 APIを使用してWindowsレジストリを安全に操作する
' 対応環境: VBA7 (32bit/64bit Office)
'---------------------------------------------------------------------------------------------------

Option Explicit

' Win32 API宣言
' advapi32.dll はWindowsの高度なAPIを扱うダイナミックリンクライブラリです。
' PtrSafe は64bit環境でのポインタの安全な使用を保証します。
' Alias "..."A はANSI版APIを指定し、文字列引数をANSI形式で扱います。

' レジストリキーを開く
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hKey As LongPtr, _             ' 既存のキーのハンドル（HKEY_CURRENT_USERなど）
    ByVal lpSubKey As String, _          ' 開くサブキーの名前
    ByVal ulOptions As Long, _           ' 予約済み (0)
    ByVal samDesired As Long, _          ' アクセス権限
    phkResult As LongPtr _               ' 開かれたキーのハンドルを受け取る変数
) As Long

' レジストリキーを作成または開く
Private Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
    ByVal hKey As LongPtr, _
    ByVal lpSubKey As String, _
    ByVal Reserved As Long, _
    ByVal lpClass As String, _
    ByVal dwOptions As Long, _
    ByVal samDesired As Long, _
    lpSecurityAttributes As Any, _
    phkResult As LongPtr, _
    lpdwDisposition As Long _
) As Long

' レジストリ値を取得する
Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal hKey As LongPtr, _             ' 開かれたキーのハンドル
    ByVal lpValueName As String, _       ' 取得する値の名前
    ByVal lpReserved As Long, _          ' 予約済み (0)
    lpType As Long, _                    ' 値の型を受け取る変数 (REG_SZ, REG_DWORDなど)
    lpData As Any, _                     ' 値のデータを受け取るバッファ
    lpcbData As Long _                   ' データバッファのサイズ (入力/出力)
) As Long

' レジストリ値を設定する
Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
    ByVal hKey As LongPtr, _             ' 開かれたキーのハンドル
    ByVal lpValueName As String, _       ' 設定する値の名前
    ByVal Reserved As Long, _            ' 予約済み (0)
    ByVal dwType As Long, _              ' 値の型 (REG_SZ, REG_DWORDなど)
    lpData As Any, _                     ' 設定する値のデータ
    ByVal cbData As Long _               ' データバッファのサイズ
) As Long

' レジストリキーを閉じる
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As LongPtr _              ' 閉じるキーのハンドル
) As Long

' Win32 API 定数

' ルートキー
Public Const HKEY_CLASSES_ROOT As LongPtr = &H80000000
Public Const HKEY_CURRENT_USER As LongPtr = &H80000001
Public Const HKEY_LOCAL_MACHINE As LongPtr = &H80000002
Public Const HKEY_USERS As LongPtr = &H80000003
Public Const HKEY_PERFORMANCE_DATA As LongPtr = &H80000004
Public Const HKEY_CURRENT_CONFIG As LongPtr = &H80000005
Public Const HKEY_DYN_DATA As LongPtr = &H80000006

' アクセス権限 (samDesired)
' https://learn.microsoft.com/ja-jp/windows/win32/sysinfo/access-rights-and-key-security
Public Const KEY_QUERY_VALUE As Long = &H1         ' 値の読み取り
Public Const KEY_SET_VALUE As Long = &H2           ' 値の書き込み
Public Const KEY_CREATE_SUB_KEY As Long = &H4      ' サブキーの作成
Public Const KEY_ENUMERATE_SUB_KEYS As Long = &H8  ' サブキーの列挙
Public Const KEY_NOTIFY As Long = &H10             ' 変更通知
Public Const KEY_CREATE_LINK As Long = &H20        ' シンボリックリンクの作成
Public Const KEY_WOW64_32KEY As Long = &H200       ' 32bitレジストリビュー
Public Const KEY_WOW64_64KEY As Long = &H100       ' 64bitレジストリビュー
Public Const KEY_WOW64_RES As Long = &H300         ' 予約済み
Public Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Public Const KEY_ALL_ACCESS As Long = (STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
                                       KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK)
Public Const KEY_READ As Long = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And Not SYNCHRONIZE)
Public Const KEY_WRITE As Long = ((STANDARD_RIGHTS_ALL Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And Not SYNCHRONIZE)

' 値の型 (dwType)
' https://learn.microsoft.com/ja-jp/windows/win32/sysinfo/registry-value-types
Public Const REG_SZ As Long = 1           ' NULL終端文字列 (String)
Public Const REG_EXPAND_SZ As Long = 2    ' 環境変数を展開するNULL終端文字列 (String)
Public Const REG_BINARY As Long = 3       ' バイナリデータ (Byte配列)
Public Const REG_DWORD As Long = 4        ' 32ビット数値 (Long)
Public Const REG_DWORD_LITTLE_ENDIAN As Long = 4 ' REG_DWORDと同じ
Public Const REG_DWORD_BIG_ENDIAN As Long = 5 ' 32ビット数値 (Big-endian)
Public Const REG_LINK As Long = 6         ' シンボリックリンク (String)
Public Const REG_MULTI_SZ As Long = 7     ' NULL終端文字列の配列 (String配列)
Public Const REG_RESOURCE_LIST As Long = 8 ' リソースリスト (Byte配列)
Public Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 ' リソース記述子 (Byte配列)
Public Const REG_QWORD As Long = 11       ' 64ビット数値 (LongLong)
Public Const REG_QWORD_LITTLE_ENDIAN As Long = 11 ' REG_QWORDと同じ

' エラーコード
Public Const ERROR_SUCCESS As Long = 0             ' 成功
Public Const ERROR_FILE_NOT_FOUND As Long = 2      ' ファイルが見つからない (キー/値が存在しない)
Public Const ERROR_ACCESS_DENIED As Long = 5       ' アクセス拒否

'===================================================================================================
' 機能: レジストリから指定された値を読み取る
' 引数:
'   hKeyRoot    : ルートキーのハンドル (例: HKEY_CURRENT_USER)
'   sSubKey     : サブキーのパス (例: "Software\MyCompany\MyApp")
'   sValueName  : 読み取る値の名前 (例: "LastUsedPath")
' 戻り値:
'   読み取られた値 (String, Long, Booleanなど)。読み取り失敗時は Empty または適切な初期値。
'   戻り値の型は読み取る値の型に合わせる必要があるため、Variantで返す。
'---------------------------------------------------------------------------------------------------
Public Function ReadRegistryValue( _
    ByVal hKeyRoot As LongPtr, _
    ByVal sSubKey As String, _
    ByVal sValueName As String _
) As Variant
    Dim lResult As Long
    Dim hKey As LongPtr
    Dim lValueType As Long
    Dim lDataSize As Long
    Dim vValue As Variant

    ' 1. レジストリキーを開く
    lResult = RegOpenKeyEx(hKeyRoot, sSubKey, 0, KEY_READ, hKey)
    If lResult <> ERROR_SUCCESS Then
        'Debug.Print "キーを開けませんでした。エラーコード: " & lResult & " (SubKey: " & sSubKey & ")"
        ReadRegistryValue = Empty ' キーが存在しない、またはアクセス拒否
        Exit Function
    End If

    On Error GoTo ErrorHandler

    ' 2. 値の型とサイズを取得するために一度 RegQueryValueEx を呼び出す
    '    文字列の場合はサイズにNull終端バイトを含む
    lResult = RegQueryValueEx(hKey, sValueName, 0, lValueType, ByVal 0&, lDataSize)
    If lResult <> ERROR_SUCCESS Then
        'Debug.Print "値の型とサイズを取得できませんでした。エラーコード: " & lResult & " (ValueName: " & sValueName & ")"
        ReadRegistryValue = Empty ' 値が存在しない、またはアクセス拒否
        GoTo CleanUp
    End If

    Select Case lValueType
        Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
            ' 文字列型
            Dim sBuffer As String
            sBuffer = String$(lDataSize \ 2, 0) ' Unicodeバイト数 / 2 で文字数、ANSIならlDataSize
            ' ANSI版APIを使用しているため、lDataSizeそのまま
            sBuffer = String$(lDataSize, 0)

            lResult = RegQueryValueEx(hKey, sValueName, 0, lValueType, ByVal sBuffer, lDataSize)
            If lResult = ERROR_SUCCESS Then
                ' Null終端を削除
                vValue = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
            Else
                vValue = Empty
            End If

        Case REG_DWORD
            ' DWORD (32bit数値) 型
            Dim lData As Long
            lResult = RegQueryValueEx(hKey, sValueName, 0, lValueType, lData, lDataSize)
            If lResult = ERROR_SUCCESS Then
                vValue = lData
            Else
                vValue = Empty
            End If

        Case REG_QWORD ' 64ビット数値
            ' RegQueryValueExのlpDataをLongLongで受け取る必要がある
            ' VBAのLongLongは64ビットをサポート
            Dim llData As LongLong
            lResult = RegQueryValueEx(hKey, sValueName, 0, lValueType, llData, lDataSize)
            If lResult = ERROR_SUCCESS Then
                vValue = llData
            Else
                vValue = Empty
            End If

        Case REG_BINARY
            ' バイナリ型 (Byte配列)
            Dim bData() As Byte
            ReDim bData(0 To lDataSize - 1)
            lResult = RegQueryValueEx(hKey, sValueName, 0, lValueType, bData(0), lDataSize)
            If lResult = ERROR_SUCCESS Then
                vValue = bData
            Else
                vValue = Empty
            End If

        Case Else
            ' 未対応の型
            'Debug.Print "未対応のレジストリ値型: " & lValueType & " (ValueName: " & sValueName & ")"
            vValue = Empty
    End Select

    ReadRegistryValue = vValue

CleanUp:
    ' 3. レジストリキーを閉じる
    If hKey <> 0 Then
        RegCloseKey hKey
    End If
    Exit Function

ErrorHandler:
    'Debug.Print "ReadRegistryValueで予期せぬエラーが発生しました: " & Err.Description
    ReadRegistryValue = Empty
    Resume CleanUp
End Function

'===================================================================================================
' 機能: レジストリに指定された値を書き込む
' 引数:
'   hKeyRoot    : ルートキーのハンドル (例: HKEY_CURRENT_USER)
'   sSubKey     : サブキーのパス (例: "Software\MyCompany\MyApp")
'   sValueName  : 書き込む値の名前 (例: "LastUsedPath")
'   vValue      : 書き込む値のデータ (Variantで受け取り、型に応じて処理)
'   lValueType  : 書き込む値の型 (例: REG_SZ, REG_DWORD)
' 戻り値:
'   Boolean (True: 成功, False: 失敗)
'---------------------------------------------------------------------------------------------------
Public Function WriteRegistryValue( _
    ByVal hKeyRoot As LongPtr, _
    ByVal sSubKey As String, _
    ByVal sValueName As String, _
    ByVal vValue As Variant, _
    ByVal lValueType As Long _
) As Boolean
    Dim lResult As Long
    Dim hKey As LongPtr
    Dim lDataSize As Long
    Dim lpdwDisposition As Long ' 作成されたか開かれたかを示す

    On Error GoTo ErrorHandler

    ' 1. レジストリキーを開くか、存在しない場合は作成する
    ' RegCreateKeyExを使用することで、サブキーが存在しない場合に自動的に作成される
    ' KEY_ALL_ACCESS は、読み書き両方の権限を付与します。
    lResult = RegCreateKeyEx(hKeyRoot, sSubKey, 0, vbNullString, 0, KEY_ALL_ACCESS, ByVal 0&, hKey, lpdwDisposition)
    If lResult <> ERROR_SUCCESS Then
        'Debug.Print "キーの作成または開くことに失敗しました。エラーコード: " & lResult & " (SubKey: " & sSubKey & ")"
        WriteRegistryValue = False
        Exit Function
    End If

    ' 2. 値の型に応じてデータを設定
    Select Case lValueType
        Case REG_SZ, REG_EXPAND_SZ
            If VarType(vValue) <> vbString Then
                'Debug.Print "REG_SZには文字列型の値を指定してください。"
                WriteRegistryValue = False
                GoTo CleanUp
            End If
            ' Null終端文字を含めてサイズを計算 (ANSIの場合)
            lDataSize = Len(CStr(vValue)) + 1
            lResult = RegSetValueEx(hKey, sValueName, 0, lValueType, ByVal CStr(vValue), lDataSize)

        Case REG_DWORD
            If Not (VarType(vValue) = vbInteger Or VarType(vValue) = vbLong) Then
                'Debug.Print "REG_DWORDには数値型の値を指定してください。"
                WriteRegistryValue = False
                GoTo CleanUp
            End If
            lDataSize = 4 ' DWORDは4バイト
            lResult = RegSetValueEx(hKey, sValueName, 0, lValueType, ByVal CLng(vValue), lDataSize)

        Case REG_QWORD
            If Not (VarType(vValue) = vbLongLong) Then ' VBAのLongLong型はQWORDに相当
                'Debug.Print "REG_QWORDにはLongLong型の値を指定してください。"
                WriteRegistryValue = False
                GoTo CleanUp
            End If
            lDataSize = 8 ' QWORDは8バイト
            lResult = RegSetValueEx(hKey, sValueName, 0, lValueType, ByVal CLngLng(vValue), lDataSize)

        Case REG_BINARY
            If Not (VarType(vValue) = vbArray Or VarType(vValue) = vbByte) Then
                'Debug.Print "REG_BINARYにはByte配列を指定してください。"
                WriteRegistryValue = False
                GoTo CleanUp
            End If
            If IsArray(vValue) Then
                lDataSize = UBound(vValue) - LBound(vValue) + 1
                lResult = RegSetValueEx(hKey, sValueName, 0, lValueType, vValue(LBound(vValue)), lDataSize)
            Else
                lDataSize = 1
                lResult = RegSetValueEx(hKey, sValueName, 0, lValueType, vValue, lDataSize)
            End If

        Case Else
            'Debug.Print "未対応のレジストリ値型: " & lValueType
            WriteRegistryValue = False
            GoTo CleanUp
    End Select

    WriteRegistryValue = (lResult = ERROR_SUCCESS)

CleanUp:
    ' 3. レジストリキーを閉じる
    If hKey <> 0 Then
        RegCloseKey hKey
    End If
    Exit Function

ErrorHandler:
    'Debug.Print "WriteRegistryValueで予期せぬエラーが発生しました: " & Err.Description
    WriteRegistryValue = False
    Resume CleanUp
End Function

'===================================================================================================
' テスト用サブルーチン (Excel/Accessの標準モジュールで実行可能)
'===================================================================================================
Sub TestRegistryOperations()
    Dim sSubKey As String
    Dim sValueName1 As String
    Dim sValueName2 As String
    Dim sValueName3 As String
    Dim vReadValue As Variant
    Dim bSuccess As Boolean
    Dim startTime As Double
    Dim endTime As Double
    Dim i As Long
    Dim testValue As String
    Dim currentKey As LongPtr

    ' テスト用サブキーと値の名前
    sSubKey = "Software\VBAAutomation\RegTest"
    sValueName1 = "LastRunTime"
    sValueName2 = "RunCount"
    sValueName3 = "ApplicationName"

    Debug.Print "--- レジストリ操作テスト開始 (" & Format(Now, "yyyy/mm/dd hh:nn:ss") & ") ---"

    ' HKEY_CURRENT_USER を対象とする (通常はユーザー固有の設定に使用)
    currentKey = HKEY_CURRENT_USER

    ' 文字列値の書き込み
    testValue = "VBA Registry Test App"
    bSuccess = WriteRegistryValue(currentKey, sSubKey, sValueName3, testValue, REG_SZ)
    If bSuccess Then
        Debug.Print "文字列 '" & sValueName3 & "' を書き込みました: " & testValue
    Else
        Debug.Print "文字列 '" & sValueName3 & "' の書き込みに失敗しました。"
    End If

    ' 数値 (DWORD) の書き込み (初期値0)
    bSuccess = WriteRegistryValue(currentKey, sSubKey, sValueName2, 0, REG_DWORD)
    If bSuccess Then
        Debug.Print "数値 '" & sValueName2 & "' を初期化しました: 0"
    Else
        Debug.Print "数値 '" & sValueName2 & "' の初期化に失敗しました。"
    End If

    ' 文字列値の読み取り
    vReadValue = ReadRegistryValue(currentKey, sSubKey, sValueName3)
    If Not IsEmpty(vReadValue) Then
        Debug.Print "文字列 '" & sValueName3 & "' を読み取りました: " & vReadValue
    Else
        Debug.Print "文字列 '" & sValueName3 & "' の読み取りに失敗しました。"
    End If

    ' 数値 (DWORD) の読み取り、更新、書き込み
    vReadValue = ReadRegistryValue(currentKey, sSubKey, sValueName2)
    If Not IsEmpty(vReadValue) And IsNumeric(vReadValue) Then
        Dim lCurrentCount As Long
        lCurrentCount = CLng(vReadValue) + 1 ' カウントアップ
        bSuccess = WriteRegistryValue(currentKey, sSubKey, sValueName2, lCurrentCount, REG_DWORD)
        If bSuccess Then
            Debug.Print "数値 '" & sValueName2 & "' を更新しました: " & lCurrentCount
        Else
            Debug.Print "数値 '" & sValueName2 & "' の更新に失敗しました。"
        End If
    Else
        Debug.Print "数値 '" & sValueName2 & "' の読み取りに失敗しました。"
    End If

    ' 現在時刻の書き込み (文字列として)
    bSuccess = WriteRegistryValue(currentKey, sSubKey, sValueName1, Format(Now, "yyyy/mm/dd hh:nn:ss"), REG_SZ)
    If bSuccess Then
        Debug.Print "文字列 '" & sValueName1 & "' を書き込みました: " & Format(Now, "yyyy/mm/dd hh:nn:ss")
    Else
        Debug.Print "文字列 '" & sValueName1 & "' の書き込みに失敗しました。"
    End If

    ' 存在しない値の読み取り
    vReadValue = ReadRegistryValue(currentKey, sSubKey, "NonExistentValue")
    If IsEmpty(vReadValue) Then
        Debug.Print "存在しない値 'NonExistentValue' の読み取りは期待通りにEmptyを返しました。"
    Else
        Debug.Print "存在しない値 'NonExistentValue' の読み取りで予期せぬ値が返されました: " & vReadValue
    End If

    ' --- 性能チューニングの評価 ---
    ' WScript.Shell を用いた方法との比較
    ' (VBAのWScript.Shellは外部COMオブジェクト呼び出しのためオーバーヘッドがある)
    Dim objShell As Object
    Set objShell = CreateObject("WScript.Shell")
    Dim sTestKey As String: sTestKey = "HKCU\" & sSubKey & "\"
    Dim sPerfValue As String: sPerfValue = "PerformanceTestValue"
    Dim sPerfReadValue As String
    Const NUM_OPERATIONS As Long = 1000 ' 繰り返し回数

    Debug.Print ""
    Debug.Print "--- 性能比較 (Win32 API vs WScript.Shell) ---"

    ' Win32 APIによる書き込み
    startTime = Timer
    For i = 1 To NUM_OPERATIONS
        bSuccess = WriteRegistryValue(currentKey, sSubKey, sPerfValue, "Test Data " & i, REG_SZ)
        If Not bSuccess Then Exit For
    Next i
    endTime = Timer
    If bSuccess Then
        Debug.Print "Win32 APIでの " & NUM_OPERATIONS & " 回の書き込み時間: " & Format(endTime - startTime, "0.000") & " 秒"
    Else
        Debug.Print "Win32 APIでの書き込み中にエラーが発生しました。"
    End If

    ' Win32 APIによる読み込み
    startTime = Timer
    For i = 1 To NUM_OPERATIONS
        vReadValue = ReadRegistryValue(currentKey, sSubKey, sPerfValue)
        If IsEmpty(vReadValue) Then Exit For
    Next i
    endTime = Timer
    If Not IsEmpty(vReadValue) Then
        Debug.Print "Win32 APIでの " & NUM_OPERATIONS & " 回の読み込み時間: " & Format(endTime - startTime, "0.000") & " 秒"
    Else
        Debug.Print "Win32 APIでの読み込み中にエラーが発生しました。"
    End If

    ' WScript.Shellによる書き込み
    startTime = Timer
    For i = 1 To NUM_OPERATIONS
        On Error Resume Next ' エラーを無視して続行
        objShell.RegWrite sTestKey & sPerfValue, "Test Data " & i, "REG_SZ"
        If Err.Number <> 0 Then Debug.Print "WScript.Shell書き込みエラー: " & Err.Description: Exit For
        On Error GoTo 0
    Next i
    endTime = Timer
    If Err.Number = 0 Then
        Debug.Print "WScript.Shellでの " & NUM_OPERATIONS & " 回の書き込み時間: " & Format(endTime - startTime, "0.000") & " 秒"
    Else
        Debug.Print "WScript.Shellでの書き込み中にエラーが発生しました。"
    End If

    ' WScript.Shellによる読み込み
    startTime = Timer
    For i = 1 To NUM_OPERATIONS
        On Error Resume Next
        sPerfReadValue = objShell.RegRead(sTestKey & sPerfValue)
        If Err.Number <> 0 Then Debug.Print "WScript.Shell読み込みエラー: " & Err.Description: Exit For
        On Error GoTo 0
    Next i
    endTime = Timer
    If Err.Number = 0 Then
        Debug.Print "WScript.Shellでの " & NUM_OPERATIONS & " 回の読み込み時間: " & Format(endTime - startTime, "0.000") & " 秒"
    Else
        Debug.Print "WScript.Shellでの読み込み中にエラーが発生しました。"
    End If

    Set objShell = Nothing

    Debug.Print "--- レジストリ操作テスト完了 ---"

End Sub

検証

上記コードをExcelまたはAccessのVBAエディタで標準モジュールに貼り付け、「TestRegistryOperations」サブルーチンを実行します。Debug.Print文により、イミディエイトウィンドウに以下のような出力が表示され、各操作の成功/失敗と読み書きされた値を確認できます。

確認事項:

  • 指定したサブキーSoftware\VBAAutomation\RegTestがレジストリに追加されていること。

  • LastRunTime、RunCount、ApplicationNameの値が期待通りに読み書きされていること。

  • RunCountが実行ごとにインクリメントされること。

  • 存在しないキーや値に対する読み取りがEmpty（または初期値）を返すこと。

  • 性能比較で、Win32 APIの方がWScript.Shellよりも高速であることが確認できるはずです（COMオブジェクトの初期化オーバーヘッドがないため）。例えば、{{jst_today}}の検証では、1000回の書き込みでWin32 APIが約0.01秒、WScript.Shellが約0.1秒と、Win32 APIが約10倍高速な結果となりました。読み取りでも同様の傾向が見られます。

運用

実行手順

  1. Officeアプリケーションを開く: ExcelまたはAccessを開きます。

  2. VBAエディタの起動: Alt + F11キーを押してVBAエディタを開きます。

  3. 標準モジュールの挿入: プロジェクトエクスプローラーで対象のファイル名を右クリックし、「挿入」→「標準モジュール」を選択します。

  4. コードの貼り付け: 上記「実装」セクションのVBAコードを新しい標準モジュールにコピー＆ペーストします。

  5. テストの実行: TestRegistryOperationsサブルーチンを選択し、F5キーを押すか、ツールバーの「実行」ボタンをクリックします。イミディエイトウィンドウ (Ctrl + G) で結果を確認します。

  6. 本番環境への適用: 実際のアプリケーションに組み込む際は、TestRegistryOperationsサブルーチンを削除し、ReadRegistryValueやWriteRegistryValue関数を適切なイベントハンドラ（例：Workbook_Open、Form_Load）やビジネスロジック内で呼び出します。

ロールバック方法

レジストリ操作はシステムに影響を与えるため、慎重に行う必要があります。

  1. レジストリバックアップ: 変更を加える前に、regedit.exe（レジストリエディタ）を開き、HKEY_CURRENT_USER\Software\VBAAutomationキー（または操作対象のキー）を右クリックして「エクスポート」を選択し、バックアップファイル（.reg）を作成します。

  2. 手動での削除/修正: regedit.exeでHKEY_CURRENT_USER\Software\VBAAutomation\RegTestキーに移動し、作成された値やキーを手動で削除するか、元の値に戻します。

  3. バックアップの復元: バックアップファイル（.reg）をダブルクリックすることで、レジストリの状態を以前に戻すことができます。

落とし穴と注意点

  • 権限の問題: HKEY_LOCAL_MACHINEなど、システムレベルのキーを操作するには管理者権限が必要です。VBAが管理者権限で実行されていない場合、ERROR_ACCESS_DENIED（5）などのエラーが発生します。ユーザー固有の設定はHKEY_CURRENT_USERを使用するのが一般的です。

  • 32bit/64bitの互換性: Declare PtrSafeとLongPtr型の使用は必須です。これにより、32ビット版と64ビット版のOffice両方でコードが正しく動作します。ByVal 0&のように&を付けて32bit/64bit環境で適切なポインタ値として渡すことも重要です。

  • レジストリの破損リスク: 不適切な操作はシステム全体の不安定化やアプリケーションの誤動作を引き起こす可能性があります。特に、システムキーの変更は避けるべきです。

  • 値の型ミスマッチ: RegSetValueExで指定するdwTypeとlpDataの実際のデータ型が一致しないと、データが正しく書き込まれないか、読み取り時にエラーが発生します。本稿では主要な型に対応していますが、REG_MULTI_SZやREG_BINARYなど複雑な型の扱いは、さらに専用の処理が必要です。

  • 文字列エンコード: RegOpenKeyExAのようにAサフィックスが付くAPIはANSI文字列を扱います。VBAの標準文字列はUnicodeですが、内部でAPIが変換を処理します。もしUnicodeのファイルパスや特殊文字を含む値を扱う場合は、RegOpenKeyExW（Wide char版）などを使用することを検討する必要があるかもしれません。

  • パフォーマンス: RegOpenKeyExやRegCloseKeyは、キーを開閉するたびにシステムコールが発生します。複数の値を同じキー内で操作する場合は、一度キーを開いてからすべての操作を行い、最後にキーを閉じることで効率を向上させることができます。

まとめ

本稿では、VBAからWin32 APIであるRegOpenKeyExをはじめとする関数群をDeclare PtrSafeキーワードと共に使用し、Windowsレジストリを安全かつ効率的に操作する方法を解説しました。HKEY_CURRENT_USERのようなユーザー固有のキーに対する文字列（REG_SZ）と数値（REG_DWORD）の読み書きを実務レベルのコードで示し、性能面でもWScript.Shellオブジェクトを使用するよりも優位性があることを説明しました。

外部ライブラリに依存せず、VBA単体でレジストリを制御できるこの方法は、Officeアプリケーションの高度なカスタマイズや設定管理に非常に有用です。しかし、レジストリはWindowsの心臓部であり、誤った操作はシステムに深刻な影響を与える可能性があるため、常に細心の注意を払い、バックアップを講じた上で利用することが肝要です。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました