専門家ロール：Office自動化・DB設計エキスパート
出力トーン：技術的誠実さを重視したプロフェッショナルな解説
構成：指示されたH1見出しから始まる9セクション構成を厳守
技術仕様：Win32 API (PtrSafe), 64bit/32bit両対応, エラーハンドリング重視 本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。
VBAとWin32 APIで実現するUAC（ユーザーアカウント制御）状態のセキュアな判定手法
【背景と目的】
VBA実行時の管理者権限不足による実行時エラーや、レジストリ書き込み失敗を未然に防ぐため、UACの設定状態を確実に取得します。（63文字）
【処理フロー図】
graph TD
A["開始"] --> B{"Win32 APIでレジストリ参照"}
B --> C["HKEY_LOCAL_MACHINEへアクセス"]
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両対応) ---
#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, 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
#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, ByRef 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, _
ByRef lpType As Long, ByRef lpData As Any, ByRef 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&
''' <summary>
''' UAC (EnableLUA) の有効状態を確認する
''' 戻り値: True (有効/通知あり), False (無効)
''' </summary>
Public Function IsUACEnabled() As Boolean
' 高速化のための描画停止（本処理はUI非依存だが、実務慣例として適用）
Application.ScreenUpdating = False
#If VBA7 Then
Dim hKey As LongPtr
#Else
Dim hKey As Long
#End If
Dim subKey As String: subKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"
Dim valueName As String: valueName = "EnableLUA"
Dim dwValue As Long
Dim dwSize As Long: dwSize = 4 ' DWORD (4 bytes)
Dim lngRet As Long
IsUACEnabled = False ' デフォルト値
' レジストリキーをオープン
lngRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subKey, 0, KEY_READ, hKey)
If lngRet = ERROR_SUCCESS Then
' 値を取得
lngRet = RegQueryValueEx(hKey, valueName, 0, 0, dwValue, dwSize)
If lngRet = ERROR_SUCCESS Then
' EnableLUA = 1 なら UAC 有効
If dwValue = 1 Then IsUACEnabled = True
End If
' キーを閉じる
RegCloseKey hKey
Else
' キーが開けない場合のエラーハンドリング
Debug.Print "Registry Key Open Failed. Error Code: " & lngRet
End If
Application.ScreenUpdating = True
End Function
''' <summary>
''' 実行テスト用プロシージャ
''' </summary>
Sub Test_UACStatus()
If IsUACEnabled() Then
MsgBox "UACは有効です。特権が必要な操作には昇格が必要です。", vbInformation
Else
MsgBox "UACは無効です。", vbExclamation
End If
End Sub
【技術解説】
Win32 API (Advapi32.dll): 標準の
WScript.Shellによるレジストリ操作よりも高速かつ詳細なエラーコード取得が可能です。EnableLUA: WindowsのUAC状態を管理する主要なレジストリ値です。これが
1の場合、ユーザーアカウント制御が機能しています。条件付きコンパイル:
#If VBA7を用いることで、Office 64bit版のLongPtrと 32bit版のLongを適切に使い分け、メモリポインタの不整合（クラッシュ原因）を回避しています。権限レベル:
KEY_READ権限でアクセスするため、管理者権限を持たない一般ユーザー環境でも状態確認自体は可能です。
【注意点と運用】
読み取り専用: 本コードは状態の「確認」のみを行います。レジストリの「変更」には管理者権限が必要です。
WOW64の挙動: 64bit OS上で32bit Officeを動かしている場合、レジストリのリダイレクトが発生する可能性がありますが、本パス（Policies\System）は通常共有されるため問題になりにくい箇所です。
例外処理: 万が一レジストリキーが存在しない場合に備え、
RegOpenKeyExの戻り値チェックを必須としています。
【まとめ】
Win32 APIを使用することで、WSHよりも低レイヤーかつ堅牢な環境判定が可能になる。
PtrSafeとLongPtrの適用により、企業の多様なOfficeバージョン混在環境に対応する。ツール実行の初期段階でUAC状態をチェックし、権限不足エラーによるデータ破損リスクを最小化する。
コメント