[META: DESIGN_DRAFT_UAC_CHECK_VBA] 本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。
VBAでWin32 APIを介してUAC（ユーザーアカウント制御）の設定状態を判定する
【背景と目的】
権限不足によるファイル操作や外部連携のエラーを防ぐため、実行前にUACの状態を確認し、予期せぬ実行停止やアクセス拒否トラブルを未然に回避します。
【処理フロー図】
graph TD
A["開始"] --> B["Win32 APIによるレジストリキーのオープン"]
B --> C{"オープン成功?"}
C -- No --> D["エラー終了"]
C -- Yes --> E["EnableLUA値を取得"]
E --> F["レジストリハンドルのクローズ"]
F --> G["UAC有効/無効を判定"]
G --> H["結果を呼び出し元へ返す"]
H --> I["終了"]
【実装：VBAコード】
Option Explicit
' --- Win32 API 宣言 (64bit/32bit両対応) ---
#If VBA7 Then
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, 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, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
#Else
Private 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
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
#End If
' --- 定数定義 ---
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const KEY_READ As Long = &H20019
Private Const ERROR_SUCCESS As Long = 0&
Private Const REG_DWORD As Long = 4
''' <summary>
''' UAC(ユーザーアカウント制御)が有効かどうかを確認する
''' </summary>
''' <returns>True: 有効, False: 無効または取得失敗</returns>
Public Function IsUACEnabled() As Boolean
' 高速化のための描画停止（本処理ではレジストリ参照のみだが、ルーチンとして組み込み）
Application.ScreenUpdating = False
#If VBA7 Then
Dim hKey As LongPtr
#Else
Dim hKey As Long
#End If
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のサイズ
IsUACEnabled = False
' 1. レジストリキーを読み取り専用でオープン
result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subKey, 0, KEY_READ, hKey)
If result = ERROR_SUCCESS Then
' 2. EnableLUA の値を取得
result = RegQueryValueEx(hKey, valueName, 0, REG_DWORD, dwValue, dwSize)
If result = ERROR_SUCCESS Then
' 1 ならば UAC 有効、0 ならば無効
If dwValue = 1 Then IsUACEnabled = True
End If
' 3. オープンしたハンドルを閉じる
RegCloseKey hKey
Else
' レジストリへのアクセス権限がない、またはパスが存在しない場合の処理
Debug.Print "Registry Open Error: " & result
End If
Application.ScreenUpdating = True
End Function
''' <summary>
''' 動作確認用テストルーチン
''' </summary>
Sub Test_UACCheck()
If IsUACEnabled() Then
MsgBox "UACは有効です。管理者権限が必要な操作には注意してください。", vbInformation
Else
MsgBox "UACは無効です。システム設定を確認してください。", vbExclamation
End If
End Sub
【技術解説】
Win32 APIの活用: VBA標準の
Environ関数等では取得できない詳細なシステム設定を確認するため、advapi32.dllのレジストリ操作関数群を使用しています。PtrSafe 宣言: Office 64bit環境でクラッシュを防ぐため、ハンドル型（
LongPtr）と条件付きコンパイルを採用し、堅牢性を確保しています。レジストリ・キー
EnableLUA: WindowsのUAC機能を根本から制御するフラグです。これが1であれば、管理者として実行していても、昇格プロセス（Consent UI）が介在する状態であることを示します。高速化と安全性:
RegOpenKeyExをKEY_READ（読み取り専用）で開くことにより、書き込み権限がない一般ユーザー環境でもエラーを最小限に抑えています。
【注意点と運用】
WOW64の挙動: 64bit OS上で32bit版Officeを実行している場合、レジストリ・リダイレクタによって参照先が変わる可能性があります。本コードのパスは
Policies\Systemであるため通常は共通ですが、環境依存の挙動には留意してください。UACレベルの詳細:
EnableLUAは「UACそのものが有効か」を判定します。「通知レベル（スライダーの位置）」までは判定しないため、より詳細な制御が必要な場合はConsentPromptBehaviorAdmin値なども併せて確認する必要があります。例外処理: API呼び出しに失敗した場合（戻り値が
ERROR_SUCCESS以外）、環境特有の権限問題が発生している可能性があるため、ログ出力等のエラーハンドリングを推奨します。
【まとめ】
ファイルアクセスエラーの事前診断として、UACの状態確認をルーチンに組み込む。
PtrSafe対応により、配布先（32bit/64bit混在）を選ばないコード構成にする。レジストリ操作は必ず
RegCloseKeyでハンドルを解放し、リソースリークを防ぐ。
