Win32 APIを用いたUAC（ユーザーアカウント制御）設定の取得と業務エラーの回避

Tech

style_prompt: technical_blog_v1

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

Win32 APIを用いたUAC（ユーザーアカウント制御）設定の取得と業務エラーの回避

【背景と目的】

管理者権限が必要なファイル操作や外部プログラム起動時、UAC設定による予期せぬ中断を防ぐため、VBAからレジストリを参照し現在の制御状態を判定します。

【処理フロー図】

graph TD
A["処理開始"] --> B["Win32 APIでレジストリキーを開く"]
B --> C{"キーの取得に成功?"}
C -->|Yes| D["EnableLUAのDWORD値を取得"]
C -->|No| E["エラー処理: 権限不足/パス相違"]
D --> F["UACの状態を判定"]
F --> G["結果を返却・終了"]

【実装：VBAコード】

Win32 APIを直接呼び出すことで、WScript.Shell等の外部ライブラリに依存せず、高速かつ確実にレジストリ値を取得します。

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_QUERY_VALUE As Long = &H1
Private Const REG_DWORD As Long = 4
Private Const ERROR_SUCCESS As Long = 0

''' <summary>
''' UAC (User Account Control) が有効かどうかを確認する
''' </summary>
''' <returns>True: 有効, False: 無効または取得失敗</returns>
Public Function IsUACEnabled() As Boolean
    Dim hKey As LongPtr
    Dim dwValue As Long
    Dim dwSize As Long
    Dim dwType As Long
    Dim subKey As String
    Dim result As Long

    ' UAC設定が格納されているレジストリパス
    subKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"
    dwSize = 4 ' DWORD (4 bytes)

    ' 描画停止など高速化処理 (本ロジックは単体で高速だが慣例として記述)
    Application.ScreenUpdating = False

    ' 1. レジストリキーを読み取り専用で開く
    result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subKey, 0, KEY_QUERY_VALUE, hKey)

    If result = ERROR_SUCCESS Then
        ' 2. EnableLUA 値 (UACの有効状態を示す) を取得
        result = RegQueryValueEx(hKey, "EnableLUA", 0, dwType, dwValue, dwSize)

        If result = ERROR_SUCCESS And dwType = REG_DWORD Then
            ' 1 なら有効、0 なら無効
            IsUACEnabled = (dwValue = 1)
        End If

        ' 3. キーを閉じる
        RegCloseKey hKey
    End If

    Application.ScreenUpdating = True
End Function

''' <summary>
''' 実行用プロシージャ
''' </summary>
Sub CheckUACStatus()
    If IsUACEnabled() Then
        MsgBox "UACは「有効」です。" & vbCrLf & "管理者権限が必要な処理でダイアログが出る可能性があります。", vbInformation
    Else
        MsgBox "UACは「無効」です。", vbInformation
    End If
End Sub

【技術解説】

  1. Win32 APIの活用: RegOpenKeyEx および RegQueryValueEx を使用することで、VBScriptの RegRead よりも詳細なエラー制御が可能です。特に PtrSafe と LongPtr を用いることで、現在のOffice主流である64bit版でも安全に動作します。

  2. EnableLUAの重要性: WindowsのUAC状態は、レジストリの EnableLUA 値に集約されます。これが 0 の場合、管理者は常に昇格状態で実行され、1 の場合は標準ユーザー権限で動作し必要に応じてダイアログが表示されます。

  3. パフォーマンス: レジストリ操作は非常に高速ですが、一連の判定を関数化することで、メイン処理の開始前に「権限チェック」として一度呼び出すだけの設計にしています。

【注意点と運用】

  • アクセス権限: HKEY_LOCAL_MACHINE は本来読み取りに権限が必要な場合がありますが、KEY_QUERY_VALUE (読み取り専用) で開く限り、標準ユーザー権限のExcelからでも参照可能です。

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

  • 例外処理: レジストリパスが存在しない、または名前が異なる特殊な環境（カスタマイズされたOS等）では、result が ERROR_SUCCESS 以外を返します。その際のデフォルト挙動をプロジェクト方針に合わせて決めておく必要があります。

【まとめ】

  1. Win32 API でレジストリを直接参照し、環境依存の少ないUAC判定を実現。

  2. 64bit環境 を考慮した PtrSafe 宣言により、最新のOffice環境に対応。

  3. 事前チェック として実装することで、自動化処理の中断による「ゾンビプロセス」の発生を未然に防ぐ。

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

コメント

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