Excel VBAマスターによるニッチで実用的なシステム情報取得と設定確認

目的/前提

本稿では、Excel VBAからWindowsの高度な機能にアクセスするための「参照設定」と「Windows API」の活用法について解説します。具体的には、WMI (Windows Management Instrumentation) を用いたシステム情報の取得、Windows APIを活用したOS環境情報の確認、セキュリティ関連設定（UAC状態）の確認、およびネットワーク関連のホスト名取得に焦点を当てます。

これらの技術を用いることで、VBA単体では不可能なOSレベルの情報を取得し、VBAアプリケーションの動作環境に応じた柔軟な処理や、システムの状態監視が可能になります。コードは64bit環境で動作するよう PtrSafe および LongPtr を適切に使用しています。

本論

1. WMI (Windows Management Instrumentation) によるシステム情報取得

WMIは、Windowsのシステム管理情報を提供する強力なフレームワークです。VBAからはCOMオブジェクトとしてアクセスし、SQLライクなWQL (WMI Query Language) を用いて、OS情報、ハードウェア情報、サービスの状態などを詳細に取得できます。

• 参照設定: Microsoft WMI Scripting Library
  • VBAエディターで [ツール] → [参照設定] を開き、リストから選択してチェックを入れます。
  • 遅延バインディング (Dim obj As Object) を使用する場合、参照設定は必須ではありませんが、コードの可読性やIDEの補完機能の恩恵を受けられなくなります。

2. Windows API によるOS環境・設定確認

Windows APIは、OSが提供する低レベルな機能に直接アクセスするためのインターフェースです。VBAでは Declare PtrSafe Function ステートメントを用いてDLL内の関数を呼び出します。これにより、WMIでは扱いにくい、あるいはより直接的な情報取得が可能になります。

• 64bit対応: PtrSafe キーワードを Declare ステートメントに追加し、ポインタを扱う引数や戻り値の型には LongPtr を使用します。これにより、32bitと64bitのVBA環境両方で安全に動作するコードを作成できます。
• 具体的な用途:
  • OSのビット数 (GetSystemInfo)
  • 特殊フォルダのパス (SHGetFolderPath)
  • レジストリ操作 (RegOpenKeyEx など) を通じたUAC状態確認
  • ホスト名取得 (GetComputerNameEx)

Winsock2について:
ユーザーはWinsock2に言及していますが、VBAでWinsock2 APIを直接操作して低レベルなネットワーク通信を行うのは非常に複雑で、多くの宣言と構造体定義、エラー処理が必要となります。一般的なVBAアプリケーションでは、Microsoft Winsock Control のようなCOMコンポーネントを使用しますが、これは古い技術であり、64bit Officeでの互換性や配布の難しさがあります。本稿では、よりシンプルかつ実用的なWMIおよびWindows API (例: GetComputerNameEx) を用いたネットワーク関連情報取得に留め、直接的なWinsock2 APIの利用は割愛します。

サンプルコード

以下のコードは、標準モジュールに記述してください。

' 標準モジュール (例: Module1)

' === Windows API宣言 ===
' PtrSafe: 64ビット環境でのポインタ安全性を保証します。
' LongPtr: ポインタサイズを表す型です。32ビットではLong、64ビットではLongLongにマッピングされます。
' StrPtr(文字列): 文字列の先頭アドレスをLongPtrで取得します。
Private Declare PtrSafe Function GetComputerNameEx Lib "kernel32" Alias "GetComputerNameExW" (ByVal NameType As Long, ByVal lpBuffer As LongPtr, ByRef nSize As Long) As Long
Private Declare PtrSafe Function GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) As Long
Private Declare PtrSafe Function SHGetFolderPath Lib "shell32.dll" Alias "SHGetFolderPathW" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, ByVal hToken As LongPtr, ByVal dwFlags As Long, ByVal pszPath As LongPtr) As Long
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExW" (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 "RegQueryValueExW" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As LongPtr, ByRef lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long

' === 定数と構造体 ===
Private Const COMPUTER_NAME_FORMAT_DnsFullyQualified As Long = 3 ' 完全修飾ドメイン名を取得
Private Const MAX_PATH As Long = 260 ' 最大パス長
Private Const CSIDL_APPDATA As Long = &H1A ' Application Data (ユーザーごとのアプリケーションデータフォルダ)
Private Const HKEY_LOCAL_MACHINE As LongPtr = &H80000002 ' HKLMレジストリハイブ
Private Const KEY_READ As Long = &H20019 ' レジストリ読み取り権限
Private Const REG_DWORD As Long = 4 ' レジストリ値の型 (32ビット整数)

' SYSTEM_INFO構造体 (OSのアーキテクチャ情報取得用)
Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As LongPtr ' ポインタ型 (64bit対応)
    lpMaximumApplicationAddress As LongPtr ' ポインタ型 (64bit対応)
    dwActiveProcessorMask As LongPtr       ' ポインタ型 (64bit対応)
    dwNumberOfProcessors As Long
    dwProcessorType As Long ' OSアーキテクチャ情報 (9=x64, 6=x86など)
    dwAllocationGranularity As Long
    wProcessorLevel As Integer
    wProcessorRevision As Integer
End Type

' === WMI関連関数 ===
' 目的: OS情報、システムサービスの状態確認
' 前提: [ツール] -> [参照設定] -> [Microsoft WMI Scripting Library] にチェック (推奨)
'       (Dim obj As Object の遅延バインディングにより参照設定なしでも動作は可能)
Public Function GetSystemInfoWMI() As String
    On Error GoTo ErrorHandler
    Dim objWMIService As Object ' SWbemServices (遅延バインディング)
    Dim colItems As Object      ' SWbemObjectSet
    Dim objItem As Object       ' SWbemObject
    Dim strInfo As String

    ' WMIサービスに接続。\\.\ はローカルコンピュータを指します。
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    ' --- OS情報取得 (Win32_OperatingSystemクラス) ---
    Set colItems = objWMIService.ExecQuery("SELECT Caption, Version, OSArchitecture, FreePhysicalMemory FROM Win32_OperatingSystem")
    For Each objItem In colItems
        strInfo = strInfo & "OS名: " & objItem.Caption & vbCrLf
        strInfo = strInfo & "OSバージョン: " & objItem.Version & vbCrLf
        strInfo = strInfo & "OSアーキテクチャ: " & objItem.OSArchitecture & vbCrLf
        strInfo = strInfo & "空き物理メモリ: " & Format(objItem.FreePhysicalMemory / 1024 / 1024, "0.00") & " GB" & vbCrLf
    Next

    ' --- 特定のサービス状態確認 (例: Print Spoolerサービス) ---
    ' Win32_Serviceクラスから"Spooler"サービスの現在の状態と開始モードを取得
    Set colItems = objWMIService.ExecQuery("SELECT Name, State, StartMode FROM Win32_Service WHERE Name='Spooler'")
    If colItems.Count > 0 Then
        For Each objItem In colItems
            strInfo = strInfo & "サービス (Spooler): " & objItem.State & " (開始モード: " & objItem.StartMode & ")" & vbCrLf
        Next
    Else
        strInfo = strInfo & "サービス (Spooler): 見つかりません" & vbCrLf
    End If

    GetSystemInfoWMI = strInfo
    Exit Function

ErrorHandler:
    GetSystemInfoWMI = "WMI処理中にエラー: " & Err.Description & vbCrLf & _
                       "WMI Scripting Libraryの参照設定またはアクセス権限を確認してください。"
End Function

' === Windows API関連関数 ===

' 目的: OSのbitness (32bit/64bit) を確認
Public Function GetOSBitness() As String
    Dim sysInfo As SYSTEM_INFO
    Call GetSystemInfo(sysInfo) ' GetSystemInfo APIを呼び出し、システム情報を取得

    ' dwProcessorType メンバーでアーキテクチャを判別
    Select Case sysInfo.dwProcessorType
        Case 9 ' PROCESSOR_ARCHITECTURE_AMD64 (x64)
            GetOSBitness = "64-bit"
        Case 6 ' PROCESSOR_ARCHITECTURE_INTEL (x86)
            GetOSBitness = "32-bit"
        Case Else
            GetOSBitness = "不明 (" & sysInfo.dwProcessorType & ")"
    End Select
End Function

' 目的: 特殊フォルダ (例: AppData) のパスを取得
' 補足: Windows Vista以降ではSHGetKnownFolderPathの使用が推奨されますが、SHGetFolderPathも引き続き利用可能です。
Public Function GetSpecialFolderPath() As String
    Dim Buffer As String
    Dim PathLen As Long
    Dim Ret As Long

    Buffer = String$(MAX_PATH, Chr(0)) ' APIがパスを書き込むためのバッファをNull文字で初期化
    PathLen = MAX_PATH ' バッファの最大サイズ

    ' SHGetFolderPath APIを呼び出し。StrPtr(Buffer)で文字列ポインタを渡します。
    Ret = SHGetFolderPath(0, CSIDL_APPDATA, 0, 0, StrPtr(Buffer))

    If Ret = 0 Then ' 成功
        GetSpecialFolderPath = Left$(Buffer, InStr(Buffer, Chr(0)) - 1) ' Null文字までを切り出す
    Else
        GetSpecialFolderPath = "特殊フォルダパス取得エラー: " & Ret
    End If
End Function

' 目的: ネットワーク上のコンピュータ名 (完全修飾ドメイン名) を取得
' 補足: これはWinsock2 APIを直接呼び出すものではありませんが、ネットワーク関連の情報取得として実用的です。
Public Function GetNetworkHostName() As String
    Dim Buffer As String
    Dim BuffSize As Long
    Dim Ret As Long

    BuffSize = 256 ' ホスト名が格納されるバッファの初期サイズ
    Buffer = String$(BuffSize, Chr(0)) ' APIが名前を書き込むためのバッファをNull文字で初期化

    ' GetComputerNameEx APIを呼び出し。完全修飾ドメイン名を取得するよう指定します。
    Ret = GetComputerNameEx(COMPUTER_NAME_FORMAT_DnsFullyQualified, StrPtr(Buffer), BuffSize)

    If Ret <> 0 Then ' 成功 (APIは成功時に非ゼロを返します)
        GetNetworkHostName = Left$(Buffer, InStr(Buffer, Chr(0)) - 1) ' Null文字までを切り出す
    Else
        GetNetworkHostName = "ホスト名取得エラー: " & Err.LastDllError & " (API結果: " & Ret & ")"
    End If
End Function

' 目的: UAC (ユーザーアカウント制御) の状態を確認 (レジストリ経由)
' 補足: この値はUACが有効/無効かを直接示すもので、レジストリを直接変更することは推奨されません。
Public Function GetUACStatus() As String
    Dim hKey As LongPtr   ' レジストリキーハンドル
    Dim lResult As Long   ' API呼び出し結果
    Dim lValue As Long    ' 読み取った値 (DWORD型)
    Dim lType As Long     ' 値の型
    Dim lSize As Long     ' 値のサイズ

    ' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System キーを開く
    ' KEY_READ: 読み取り専用で開きます。
    lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", 0, KEY_READ, hKey)

    If lResult = 0 Then ' キーが開けた場合 (ERROR_SUCCESS)
        lSize = 4 ' "EnableLUA" はDWORD (4バイト)
        ' "EnableLUA" の値を取得
        lResult = RegQueryValueEx(hKey, "EnableLUA", 0, lType, VarPtr(lValue), lSize)
        Call RegCloseKey(hKey) ' 開いたキーは必ず閉じます

        If lResult = 0 And lType = REG_DWORD Then ' 値の取得に成功し、型がDWORDの場合
            If lValue = 1 Then
                GetUACStatus = "有効"
            Else
                GetUACStatus = "無効"
            End If
        Else
            GetUACStatus = "EnableLUA値の取得エラーまたはタイプ不一致: " & lResult
        End If
    Else
        ' アクセス拒否 (lResult=5) など、レジストリキーオープンに失敗した場合
        GetUACStatus = "レジストリキーオープンエラー: " & lResult & " (アクセス権限不足の可能性あり)"
    End If
End Function


' === 全てのチェックを実行するテストプロシージャ ===
Public Sub RunAllSystemChecks()
    Debug.Print "--- システム情報 (WMI) ---"
    Debug.Print GetSystemInfoWMI()
    Debug.Print ""

    Debug.Print "--- OS Bitness (Windows API) ---"
    Debug.Print "OSアーキテクチャ: " & GetOSBitness()
    Debug.Print ""

    Debug.Print "--- 特殊フォルダ (Windows API) ---"
    Debug.Print "AppDataパス: " & GetSpecialFolderPath()
    Debug.Print ""

    Debug.Print "--- ネットワークホスト名 (Windows API) ---"
    Debug.Print "完全修飾ホスト名: " & GetNetworkHostName()
    Debug.Print ""

    Debug.Print "--- UAC状態 (Windows API - レジストリ) ---"
    Debug.Print "UAC状態: " & GetUACStatus()
End Sub

検証

1. VBAエディターを開く: Excelを開き、Alt + F11 でVBAエディターを起動します。
2. 標準モジュールを挿入: [挿入] -> [標準モジュール] を選択します。
3. コードの貼り付け: 上記のサンプルコードを新しいモジュールに貼り付けます。
4. WMI参照設定 (オプション): WMI関数を遅延バインディングではない形で利用する場合は、[ツール] -> [参照設定] から Microsoft WMI Scripting Library にチェックを入れます。遅延バインディングの場合は不要です。
5. プロシージャの実行: RunAllSystemChecks プロシージャ内にカーソルを置き、F5 キーを押して実行します。
6. 結果の確認: [表示] -> [イミディエイトウィンドウ] (Ctrl + G) で、各関数の実行結果が表示されることを確認します。OS情報、OSビット数、AppDataパス、ホスト名、UAC状態が正しく表示されれば成功です。

最小テスト

入力: Call RunAllSystemChecks (イミディエイトウィンドウで実行、またはVBAプロシージャとして実行)

想定結果:
イミディエイトウィンドウに以下のような情報が出力される。
– WMI: OS名、OSバージョン、OSアーキテクチャ (例: “64-bit”)、空きメモリ、”Spooler”サービスの状態
– OS Bitness: OSのビット数 (例: “64-bit”)
– 特殊フォルダ: ユーザーのAppDataフォルダのパス (例: “C:\Users\username\AppData\Roaming”)
– ネットワークホスト名: コンピュータの完全修飾ドメイン名 (例: “hostname.domain.local”)
– UAC状態: “有効” または “無効”

エッジケース:
– WMI参照設定なし: GetSystemInfoWMI 関数は遅延バインディングで記述しているため、参照設定がなくても動作します。ただし、オブジェクトのプロパティやメソッドに対するIDEの補完機能は利用できません。
– 権限不足: レジストリへのアクセスや一部のWMIクエリは管理者権限が必要な場合があります。その場合、関連する関数はエラーメッセージを返します。

反証/例外

• 権限の問題:
  • WMIクエリやレジストリ操作は、実行中のExcelプロセスに適切な権限が必要です。特に HKEY_LOCAL_MACHINE 以下へのアクセスやサービス状態の変更などには管理者権限が求められることがあります。通常ユーザーで実行した場合、アクセス拒否エラー (例: “アクセスが拒否されました” またはAPIのエラーコード 5) が発生する可能性があります。
  • 解決策: Excelを管理者として実行するか、より限定的な情報にアクセスするWMIクラスやAPIを選択してください。
• バージョン差と互換性:
  • PtrSafe と LongPtr は Office 2010以降 で導入されました。それ以前のOfficeバージョンでは動作しません。
  • Declare ステートメントの Alias や W (Unicode) は、OSやOfficeの言語設定に依存する問題を避けるために重要です。
  • 一部の古いWindows APIは、最新のWindowsバージョンで非推奨または動作しない可能性があります (SHGetFolderPath より SHGetKnownFolderPath が推奨されるなど)。
• 参照設定の落とし穴:
  • Microsoft WMI Scripting Library のようなCOM参照設定は、ライブラリがインストールされていない環境では「参照設定が見つかりません」エラーになります。
  • 遅延バインディング (Dim obj As Object) を使用すれば参照設定は不要になりますが、実行時エラーのリスクが増え、IDEの支援機能 (IntelliSense) が使えなくなります。
• セキュリティ留意点:
  • Windows APIを直接呼び出すことは強力ですが、不適切な使用はExcelやOSを不安定にする可能性があります。特にメモリ操作やレジストリへの書き込みは慎重に行うべきです。
  • WMIは情報収集には便利ですが、悪意のあるWQLクエリはシステムリソースを大量に消費する可能性があります。
  • レジストリの EnableLUA 値の直接的な変更は、システムを不安定にする可能性があるため、参照のみに留めるべきです。
• Err.LastDllError の使用: Windows API呼び出しで失敗した場合、Err.LastDllError を参照することで詳細なエラーコードが得られますが、必ずしもVBAの Err.Description と一致するわけではありません。

動作条件表

エビデンステーブル