VBAでWin32 APIを叩き、レジストリからUAC（ユーザーアカウント制御）の有効状態を判定する

Tech

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

VBAでWin32 APIを叩き、レジストリからUAC（ユーザーアカウント制御）の有効状態を判定する

【背景と目的】

管理者権限が必要なファイル操作やシステム設定を行う際、UAC設定による予期せぬ中断や実行エラーを未然に防ぐため、Win32 APIでレジストリを直接参照し状態を判定します。

【処理フロー図】

graph TD
A["開始"] --> B["Win32 APIの宣言"]
B --> C["レジストリキー HKLM をオープン"]
C --> D["EnableLUA 値をクエリ"]
D --> E{"値が 1 か?"}
E -->|Yes| F["UAC 有効と判定"]
E -->|No| G["UAC 無効と判定"]
F --> H["レジストリハンドルをクローズ"]
G --> H
H --> I["終了"]

【実装：VBAコード】

Option Explicit

' --- Win32 API 宣言 (64bit/32bit 両対応) ---
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hKey As LongPtr, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    ByRef phkResult As LongPtr) As Long

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

Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As LongPtr) As Long

' 定数定義
Private Const HKEY_LOCAL_MACHINE As LongPtr = &H80000002
Private Const KEY_READ As Long = &H20019
Private Const ERROR_SUCCESS As Long = 0&
Private Const REG_DWORD As Long = 4

''' <summary>
''' UAC (EnableLUA) の状態を確認するメインルーチン
''' </summary>
Public Sub CheckUACStatus()
    Dim uacEnabled As Boolean

    ' 高速化設定（本処理では描画停止は影響少ないが、実務テンプレートとして含める）
    Application.ScreenUpdating = False

    On Error GoTo ErrorHandler

    uacEnabled = IsUACEnabled()

    If uacEnabled Then
        MsgBox "UAC（ユーザーアカウント制御）は [有効] です。" & vbCrLf & _
               "管理者権限が必要な処理では昇格が必要です。", vbInformation
    Else
        MsgBox "UAC（ユーザーアカウント制御）は [無効] です。", vbExclamation
    End If

CleanUp:
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    Resume CleanUp
End Sub

''' <summary>
''' レジストリを参照し、EnableLUAの値を取得する
''' </summary>
Private Function IsUACEnabled() As Boolean
    Dim hKey As LongPtr
    Dim subKey As String
    Dim valueName As String
    Dim dwValue As Long
    Dim dwSize As Long
    Dim result As Long

    ' UAC設定のレジストリパス
    subKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"
    valueName = "EnableLUA"
    dwSize = 4 ' DWORDのサイズ

    ' キーをオープン
    result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subKey, 0, KEY_READ, hKey)

    If result = ERROR_SUCCESS Then
        ' 値をクエリ
        result = RegQueryValueEx(hKey, valueName, 0, REG_DWORD, dwValue, dwSize)

        ' ハンドルを確実に閉じる
        RegCloseKey hKey

        If result = ERROR_SUCCESS Then
            ' 1 なら UAC 有効
            IsUACEnabled = (dwValue = 1)
            Exit Function
        End If
    End If

    ' 取得失敗時は安全のため True (有効) とみなすかエラー処理
    IsUACEnabled = True
End Function

【技術解説】

  1. Win32 APIの採用理由: WScript.Shell の RegRead メソッドでも取得可能ですが、Win32 APIを使用することで外部オブジェクトの依存を減らし、読み取り専用（KEY_READ）のアクセス権限を明示的に指定することで、セキュリティソフトによる過度な検知を回避しやすくなります。

  2. PtrSafe と LongPtr: 64bit版Excelでの動作を保証するため、ポインタを扱う変数（hKey）には LongPtr を適用しています。

  3. レジストリパス: HKEY_LOCAL_MACHINE 直下の EnableLUA 値は、WindowsのUAC機能そのもののオン/オフを司るフラグです。

【注意点と運用】

  • 読み取り権限: 通常、このレジストリパスは一般ユーザー権限でも読み取り可能ですが、極端に制限された環境では RegOpenKeyEx が失敗する可能性があります。その場合は戻り値 result を確認してください。

  • 再起動の反映: UAC設定をレジストリで変更しても、OSを再起動するまでは EnableLUA の実際の挙動とレジストリ値が一致しない場合があります。本コードはあくまで「現在の設定値」を取得するものです。

  • 例外処理: RegCloseKey を忘れるとリソースリークの原因となるため、必ず RegOpenKeyEx が成功した後はクローズ処理を通るように設計しています。

【まとめ】

  • Win32 APIの活用: PtrSafe 宣言により、32bit/64bitを問わない堅牢なツール開発が可能。

  • 事前チェックの重要性: 重い処理の前にUAC状態を確認することで、権限エラーによる不完全なデータ更新を防止。

  • リソース管理: ハンドルのオープンとクローズを対にすることで、安定したVBA実行環境を維持。

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

コメント

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