VBAでWMIによるPC情報取得

Tech

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

VBAでWMIによるPC情報取得

背景/要件

現代のビジネス環境において、PCは業務遂行に不可欠なツールであり、その適切な管理は企業運営の根幹を成します。しかし、多数のPCが導入された環境では、各PCのハードウェア構成、OS情報、ネットワーク設定などを手動で把握し続けることは困難です。資産管理、トラブルシューティング、セキュリティ監査といった業務では、常に正確なPC情報が求められます。

VBA (Visual Basic for Applications) は、Microsoft Officeアプリケーションの自動化を強力に推進するプログラミング言語です。VBAからWMI (Windows Management Instrumentation) を利用することで、Windows OSが持つ豊富なシステム情報をプログラム的に取得・操作することが可能になります。WMIはWindowsに標準搭載された管理インフラであり、外部ライブラリを追加することなくPCの詳細情報にアクセスできるため、VBAによるOffice自動化との相性は抜群です。 、VBAを用いてWMIからPC情報を取得する実践的な手法を解説します。特に、ExcelやAccessといったOfficeアプリケーションでの実務レベルでの再現性を重視し、以下の要件を満たすことを目指します。

  • 主要なPC情報の取得: OS、CPU、メモリ、ディスク、ネットワークなどの基本情報を網羅的に取得します。

  • Win32 APIの活用: WMIでは取得しにくい、あるいは補完的な情報について、Declare PtrSafe を用いたWin32 APIの呼び出しを組み込みます。

  • Officeアプリケーションでの実用例: Excelへのシート出力、Accessへのテーブル格納といった具体的な実装コードを提示します。

  • 性能チューニング: 大量データや複数PCからの情報取得を想定し、処理速度向上のための最適化手法（配列バッファ、ScreenUpdating停止など）を具体的に示します。

  • 堅牢性: エラーハンドリングや運用時の注意点についても触れます。

設計

データモデル

取得するPC情報は、以下のカテゴリと項目に分類し、取得したデータを構造化して扱います。

  • OS情報: OS名 (Caption), バージョン (Version), アーキテクチャ (OSArchitecture), 物理メモリ総量 (TotalPhysicalMemory)

  • CPU情報: CPU名 (Name), コア数 (NumberOfCores), 論理プロセッサ数 (NumberOfLogicalProcessors)

  • メモリ情報 (WMI): 物理メモリ総量 (TotalPhysicalMemory, Win32_OperatingSystemから)

  • メモリ情報 (Win32 API): メモリ使用率 (dwMemoryLoad), 物理メモリ総量 (ullTotalPhys), 利用可能物理メモリ (ullAvailPhys) など詳細情報

  • ディスク情報: ドライブレター (DeviceID), ボリューム名 (Caption), サイズ (Size), 空き容量 (FreeSpace)

  • ネットワーク情報: アダプタ名 (Description), MACアドレス (MACAddress), IPアドレス (IPAddress)

WMIクラス選定

上記のデータモデルに基づき、主に以下のWMIクラスを使用します。

  • Win32_OperatingSystem: OSに関する情報

  • Win32_Processor: CPUに関する情報

  • Win32_LogicalDisk: 論理ディスクに関する情報

  • Win32_NetworkAdapterConfiguration: ネットワークアダプタに関する情報 (IPEnabled=Trueで有効なアダプタに絞る)

Win32 APIの選定

メモリの利用状況を詳細に取得するため、GlobalMemoryStatusEx 関数をWin32 APIとして採用します。この関数は、システム全体のメモリ使用状況をバイト単位で提供し、WMIだけでは得にくい詳細な動的情報を補完します。

処理フロー

graph TD
    A["開始"] --> B{"性能チューニング設定"};
    B --> C["WMIサービス接続"];
    C --> D{"WMIクエリ実行"};
    D --|OS情報取得|--> E[Win32_OperatingSystem];
    D --|CPU情報取得|--> F[Win32_Processor];
    D --|ディスク情報取得|--> G[Win32_LogicalDisk];
    D --|ネットワーク情報取得|--> H[Win32_NetworkAdapterConfiguration];
    E --> I["情報収集"];
    F --> I;
    G --> I;
    H --> I;
    C --> J{"Win32 API呼び出し"};
    J --|メモリ詳細取得|--> K[GlobalMemoryStatusEx];
    K --> I;
    I --> L["データバッファリング"];
    L --> M{"Officeアプリケーションへの出力"};
    M --|Excelへ出力|--> N["ワークシートに一括書き込み"];
    M --|Accessへ出力|--> O["レコードセットでテーブルに書き込み"];
    N --> P{"性能チューニング解除"};
    O --> P;
    P --> Q["終了"];
    B --|エラー発生|--> R["エラーハンドリング"];
    Q --|正常終了|--> R;

性能最適化戦略

  1. 一括書き込み: Officeアプリケーションへの書き込みは、セルやレコード単位でループ処理を行うと非常に低速になります。取得したデータは配列にバッファリングし、Rangeオブジェクトへの一括代入 (Excel) や、DAO.Recordsetを用いたバッチ更新/トランザクション処理 (Access) で高速化を図ります。

  2. 画面更新/イベント/計算モードの停止: Excelにおいては、Application.ScreenUpdating = False、Application.EnableEvents = False、Application.Calculation = xlCalculationManual を設定することで、描画処理やイベント発生、自動再計算によるオーバーヘッドを削減します。Accessでは、同様の直接的な設定はありませんが、レコードセットの最適化やトランザクション利用が有効です。

  3. WMIクエリの最適化: SELECT * FROM ... のように全てのプロパティを取得するのではなく、必要なプロパティのみを SELECT 句で指定することで、ネットワーク帯域や処理負荷を軽減します。

実装

Win32 APIを宣言するためのモジュールと、Excel/AccessそれぞれにPC情報を取得・出力するコードを記述します。

共通モジュール (標準モジュールに記述)

GlobalMemoryStatusEx関数とその関連構造体を宣言します。VBA7 (64-bit Office) では LongLong 型を、VBA6 (32-bit Office) では Currency 型を ULONGLONG の代用として使用するため、条件付きコンパイルを適用します。

' 標準モジュール（例: Module1）に記述

#If VBA7 Then

    Private Declare PtrSafe Function GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUSEX) As Long
    Private Type MEMORYSTATUSEX
        dwLength As Long
        dwMemoryLoad As Long
        ullTotalPhys As LongLong       ' Total physical memory (bytes)
        ullAvailPhys As LongLong       ' Available physical memory (bytes)
        ullTotalPageFile As LongLong
        ullAvailPageFile As LongLong
        ullTotalVirtual As LongLong
        ullAvailVirtual As LongLong
        ullAvailExtendedVirtual As LongLong
    End Type
#Else

    Private Declare Function GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUSEX) As Long
    Private Type MEMORYSTATUSEX
        dwLength As Long
        dwMemoryLoad As Long
        ullTotalPhys As Currency      ' Use Currency as a workaround for ULONGLONG on 32-bit (scaled by 10000)
        ullAvailPhys As Currency
        ullTotalPageFile As Currency
        ullAvailPageFile As Currency
        ullTotalVirtual As Currency
        ullAvailVirtual As Currency
        ullAvailExtendedVirtual As Currency
    End Type
#End If

' GlobalMemoryStatusEx から取得したバイト数をGBに変換するヘルパー関数
Function BytesToGB(ByVal Bytes As Variant) As Double
#If VBA7 Then

    BytesToGB = CDbl(Bytes) / (1024 ^ 3)
#Else

    ' Currency型の場合、実際の値は10000倍されているため、まず10000で割る
    BytesToGB = CDbl(Bytes * 10000#) / (1024 ^ 3)
#End If

End Function

Excel向けコード (標準モジュールに記述)

新しいシートを作成し、取得したPC情報を表形式で出力します。配列バッファとアプリケーション設定の最適化を適用しています。

' Excel: PC情報取得とシートへの出力
Sub GetPCInfoToExcel()
    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim ws As Worksheet
    Dim rowIdx As Long ' 配列の行インデックス
    Dim dataArr() As Variant
    Dim i As Long
    Dim startTime As Double, endTime As Double ' 性能計測用

    startTime = Timer ' 処理開始時間計測

    ' 性能チューニング開始
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    On Error GoTo ErrorHandler

    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "PC情報_" & Format(Now, "YYYYMMDD_HHMMSS")

    ' ヘッダーの定義
    Dim headers() As Variant
    headers = Array("項目", "値")
    ws.Range("A1:B1").Value = headers
    ws.Range("A1:B1").Font.Bold = True
    ws.Range("A1:B1").Interior.Color = RGB(220, 230, 241)

    ' データバッファリング用の配列を準備
    ' 取得する項目数を考慮し、十分なサイズで初期化 (例: OS=4, CPU=3, MemAPI=5, Disk=N*3, Net=N*2+N*M)
    ' 最悪ケースを想定して多めに確保
    ReDim dataArr(1 To 100, 1 To 2)
    rowIdx = 0 ' ヘッダーを除くデータ開始位置

    ' WMI サービスに接続
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    ' --- OS情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Caption, Version, OSArchitecture, TotalPhysicalMemory FROM Win32_OperatingSystem")
    For Each objItem In colItems
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "OS名": dataArr(rowIdx, 2) = objItem.Caption
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "OSバージョン": dataArr(rowIdx, 2) = objItem.Version
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "OSアーキテクチャ": dataArr(rowIdx, 2) = objItem.OSArchitecture
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "物理メモリ総量(WMI)": dataArr(rowIdx, 2) = Format(CDbl(objItem.TotalPhysicalMemory) / (1024 ^ 3), "0.00") & " GB"
    Next

    ' --- CPU情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Name, NumberOfCores, NumberOfLogicalProcessors FROM Win32_Processor")
    For Each objItem In colItems
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "CPU名": dataArr(rowIdx, 2) = objItem.Name
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "コア数": dataArr(rowIdx, 2) = objItem.NumberOfCores
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "論理プロセッサ数": dataArr(rowIdx, 2) = objItem.NumberOfLogicalProcessors
    Next

    ' --- メモリ情報 (Win32 API) ---
    Dim memStatus As MEMORYSTATUSEX
    memStatus.dwLength = Len(memStatus)
    If GlobalMemoryStatusEx(memStatus) Then
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "--- メモリ詳細 (Win32 API) ---": dataArr(rowIdx, 2) = ""
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "メモリ使用率": dataArr(rowIdx, 2) = memStatus.dwMemoryLoad & " %"
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "物理メモリ総量": dataArr(rowIdx, 2) = Format(BytesToGB(memStatus.ullTotalPhys), "0.00") & " GB"
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "利用可能物理メモリ": dataArr(rowIdx, 2) = Format(BytesToGB(memStatus.ullAvailPhys), "0.00") & " GB"
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "ページファイル総量": dataArr(rowIdx, 2) = Format(BytesToGB(memStatus.ullTotalPageFile), "0.00") & " GB"
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "利用可能ページファイル": dataArr(rowIdx, 2) = Format(BytesToGB(memStatus.ullAvailPageFile), "0.00") & " GB"
    Else
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "メモリ詳細 (Win32 API)": dataArr(rowIdx, 2) = "取得失敗"
    End If

    ' --- ディスク情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT DeviceID, Caption, Size, FreeSpace FROM Win32_LogicalDisk WHERE DriveType = 3") ' DriveType=3: ローカルディスク
    For Each objItem In colItems
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "--- ドライブ: " & objItem.DeviceID & " ---": dataArr(rowIdx, 2) = ""
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "ボリューム名": dataArr(rowIdx, 2) = objItem.Caption
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "サイズ": dataArr(rowIdx, 2) = Format(CDbl(objItem.Size) / (1024 ^ 3), "0.00") & " GB"
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "空き容量": dataArr(rowIdx, 2) = Format(CDbl(objItem.FreeSpace) / (1024 ^ 3), "0.00") & " GB"
    Next

    ' --- ネットワークアダプタ情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Description, MACAddress, IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each objItem In colItems
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "--- ネットワークアダプタ: " & objItem.Description & " ---": dataArr(rowIdx, 2) = ""
        rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "MACアドレス": dataArr(rowIdx, 2) = objItem.MACAddress
        If Not IsNull(objItem.IPAddress) Then
            For i = LBound(objItem.IPAddress) To UBound(objItem.IPAddress)
                rowIdx = rowIdx + 1: dataArr(rowIdx, 1) = "IPアドレス(" & i + 1 & ")": dataArr(rowIdx, 2) = objItem.IPAddress(i)
            Next i
        End If
    Next

    ' 実際のデータ数に合わせて配列をリサイズし、シートに一括書き込み
    If rowIdx > 0 Then
        ReDim Preserve dataArr(1 To rowIdx, 1 To 2)
        ws.Range("A2").Resize(rowIdx, 2).Value = dataArr ' ヘッダーの下から書き込み
    End If

    ' 整形
    ws.Columns("A:B").AutoFit
    ws.Columns("A:B").HorizontalAlignment = xlLeft

    endTime = Timer ' 処理終了時間計測

    MsgBox "PC情報の取得が完了し、シート '" & ws.Name & "' に出力されました。" & vbCrLf & _
           "処理時間: " & Format(endTime - startTime, "0.00") & " 秒", vbInformation

ExitHandler:
    ' 性能チューニング解除
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    Set ws = Nothing
    Set objWMIService = Nothing
    Set colItems = Nothing
    Set objItem = Nothing
    Exit Sub

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

Access向けコード (標準モジュールに記述)

新しいテーブルを作成し、取得したPC情報を格納します。DAO.Recordsetを用いた効率的なデータ追加を実装しています。

' Access: PC情報取得とテーブルへの出力
Sub GetPCInfoToAccess()
    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim strTableName As String
    Dim i As Long
    Dim startTime As Double, endTime As Double ' 性能計測用

    startTime = Timer ' 処理開始時間計測

    Set db = CurrentDb
    strTableName = "PC_Info_" & Format(Now, "YYYYMMDD_HHMMSS")

    On Error GoTo ErrorHandler

    ' テーブル定義
    Set tdf = db.CreateTableDef(strTableName)
    With tdf
        .Fields.Append .CreateField("InfoCategory", dbText, 50)
        .Fields.Append .CreateField("InfoName", dbText, 100)
        .Fields.Append .CreateField("InfoValue", dbMemo) ' 値が長くなる可能性があるのでMemo型
    End With
    db.TableDefs.Append tdf

    ' レコードセットを開く
    ' 性能向上のため、トランザクションとバッチ更新を適用
    db.BeginTrans
    Set rs = db.OpenRecordset(strTableName, dbOpenTable)
    rs.BatchUpdates = True ' バッチ更新を有効にする (ADOではCursorLocation, UpdateBatch)

    ' WMI サービスに接続
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    ' --- OS情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Caption, Version, OSArchitecture, TotalPhysicalMemory FROM Win32_OperatingSystem")
    For Each objItem In colItems
        With rs
            .AddNew
            .Fields("InfoCategory").Value = "OS情報"
            .Fields("InfoName").Value = "OS名"
            .Fields("InfoValue").Value = objItem.Caption
            .Update
            .AddNew
            .Fields("InfoCategory").Value = "OS情報"
            .Fields("InfoName").Value = "OSバージョン"
            .Fields("InfoValue").Value = objItem.Version
            .Update
            .AddNew
            .Fields("InfoCategory").Value = "OS情報"
            .Fields("InfoName").Value = "OSアーキテクチャ"
            .Fields("InfoValue").Value = objItem.OSArchitecture
            .Update
            .AddNew
            .Fields("InfoCategory").Value = "OS情報"
            .Fields("InfoName").Value = "物理メモリ総量(WMI)"
            .Fields("InfoValue").Value = Format(CDbl(objItem.TotalPhysicalMemory) / (1024 ^ 3), "0.00") & " GB"
            .Update
        End With
    Next

    ' --- CPU情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Name, NumberOfCores, NumberOfLogicalProcessors FROM Win32_Processor")
    For Each objItem In colItems
        With rs
            .AddNew
            .Fields("InfoCategory").Value = "CPU情報"
            .Fields("InfoName").Value = "CPU名"
            .Fields("InfoValue").Value = objItem.Name
            .Update
            .AddNew
            .Fields("InfoCategory").Value = "CPU情報"
            .Fields("InfoName").Value = "コア数"
            .Fields("InfoValue").Value = objItem.NumberOfCores
            .Update
            .AddNew
            .Fields("InfoCategory").Value = "CPU情報"
            .Fields("InfoName").Value = "論理プロセッサ数"
            .Fields("InfoValue").Value = objItem.NumberOfLogicalProcessors
            .Update
        End With
    Next

    ' --- メモリ情報 (Win32 API) ---
    Dim memStatus As MEMORYSTATUSEX
    memStatus.dwLength = Len(memStatus)
    If GlobalMemoryStatusEx(memStatus) Then
        With rs
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "メモリ使用率": .Fields("InfoValue").Value = memStatus.dwMemoryLoad & " %": .Update
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "物理メモリ総量": .Fields("InfoValue").Value = Format(BytesToGB(memStatus.ullTotalPhys), "0.00") & " GB": .Update
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "利用可能物理メモリ": .Fields("InfoValue").Value = Format(BytesToGB(memStatus.ullAvailPhys), "0.00") & " GB": .Update
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "ページファイル総量": .Fields("InfoValue").Value = Format(BytesToGB(memStatus.ullTotalPageFile), "0.00") & " GB": .Update
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "利用可能ページファイル": .Fields("InfoValue").Value = Format(BytesToGB(memStatus.ullAvailPageFile), "0.00") & " GB": .Update
        End With
    Else
        With rs
            .AddNew: .Fields("InfoCategory").Value = "メモリ情報(API)": .Fields("InfoName").Value = "取得ステータス": .Fields("InfoValue").Value = "取得失敗": .Update
        End With
    End If

    ' --- ディスク情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT DeviceID, Caption, Size, FreeSpace FROM Win32_LogicalDisk WHERE DriveType = 3")
    For Each objItem In colItems
        With rs
            .AddNew: .Fields("InfoCategory").Value = "ディスク情報(" & objItem.DeviceID & ")": .Fields("InfoName").Value = "ボリューム名": .Fields("InfoValue").Value = objItem.Caption: .Update
            .AddNew: .Fields("InfoCategory").Value = "ディスク情報(" & objItem.DeviceID & ")": .Fields("InfoName").Value = "サイズ": .Fields("InfoValue").Value = Format(CDbl(objItem.Size) / (1024 ^ 3), "0.00") & " GB": .Update
            .AddNew: .Fields("InfoCategory").Value = "ディスク情報(" & objItem.DeviceID & ")": .Fields("InfoName").Value = "空き容量": .Fields("InfoValue").Value = Format(CDbl(objItem.FreeSpace) / (1024 ^ 3), "0.00") & " GB": .Update
        End With
    Next

    ' --- ネットワークアダプタ情報 ---
    Set colItems = objWMIService.ExecQuery("SELECT Description, MACAddress, IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each objItem In colItems
        With rs
            .AddNew: .Fields("InfoCategory").Value = "ネットワークアダプタ(" & objItem.Description & ")": .Fields("InfoName").Value = "MACアドレス": .Fields("InfoValue").Value = objItem.MACAddress: .Update
            If Not IsNull(objItem.IPAddress) Then
                For i = LBound(objItem.IPAddress) To UBound(objItem.IPAddress)
                    .AddNew: .Fields("InfoCategory").Value = "ネットワークアダプタ(" & objItem.Description & ")": .Fields("InfoName").Value = "IPアドレス(" & i + 1 & ")": .Fields("InfoValue").Value = objItem.IPAddress(i): .Update
                Next i
            End If
        End With
    Next

    ' バッチ更新とトランザクションのコミット
    rs.UpdateBatch ' 未コミットの変更をすべてコミット
    db.CommitTrans

    endTime = Timer ' 処理終了時間計測

    MsgBox "PC情報の取得が完了し、テーブル '" & strTableName & "' に出力されました。" & vbCrLf & _
           "処理時間: " & Format(endTime - startTime, "0.00") & " 秒", vbInformation

ExitHandler:
    If db.Transactions > 0 Then db.Rollback ' エラー時はトランザクションをロールバック
    If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Set objWMIService = Nothing
    Set colItems = Nothing
    Set objItem = Nothing
    Exit Sub

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

検証

実行手順

  1. VBAエディタを開く: ExcelまたはAccessを開き、Alt + F11キーを押してVBAエディタ (VBE) を開きます。

  2. 標準モジュールの作成: プロジェクトエクスプローラーで該当するOfficeアプリケーションのプロジェクトを選択し、挿入 > 標準モジュール をクリックします。

  3. 共通モジュールの貼り付け: 作成した標準モジュールに、上記「共通モジュール」のコードを貼り付けます。

  4. アプリケーション別コードの貼り付け:

    • Excelの場合: 別の標準モジュールを作成し、「Excel向けコード」を貼り付けます。

    • Accessの場合: 別の標準モジュールを作成し、「Access向けコード」を貼り付けます。

  5. コードの実行:

    • Excel: VBEのツールバーにある 実行 > Sub/ユーザーフォームの実行 (または F5 キー) をクリックし、GetPCInfoToExcel を選択して実行します。

    • Access: VBEのツールバーにある 実行 > Sub/ユーザーフォームの実行 (または F5 キー) をクリックし、GetPCInfoToAccess を選択して実行します。

確認項目

  • Excel: 新しいシートが追加され、OS、CPU、メモリ、ディスク、ネットワークなどのPC情報がA列とB列に正しく出力されていることを確認します。メモリ情報がWin32 API (GlobalMemoryStatusEx) によって詳細に取得されているか確認します。

  • Access: 新しいテーブル (PC_Info_YYYYMMDD_HHMMSSのような名前) が作成され、カテゴリ、項目名、値の形式でPC情報が格納されていることを確認します。

  • 情報の正確性: 出力された情報が、ご自身のPCの設定（OSバージョン、搭載メモリ量、ディスク容量など）と一致しているか確認します。

  • エラーハンドリング: 例えば、WMIサービスが停止している、権限がないなどの状況を意図的に作り出し、エラーメッセージが適切に表示されるかを確認します。

性能チューニング効果の計測

上記のコードにはTimer関数による処理時間計測が組み込まれています。

  • 性能チューニングあり（現状のコード）:

    • Excel: 0.1秒～0.5秒程度 (PCのスペックやWMIクエリ数、ネットワークアダプタ数による)

    • Access: 0.2秒～0.8秒程度 (同上)

  • 性能チューニングなし（比較例）:

    • ExcelでApplication.ScreenUpdating = True、Application.Calculation = xlCalculationAutomaticのまま、かつセルに1つずつ書き込む場合 (ws.Cells(rowNum, 1).Value = "項目"; ws.Cells(rowNum, 2).Value = "値")

      • 約100項目の出力で、3秒～5秒以上かかる可能性があります。これは、シートの再描画、セルの再計算、イベント発生といったオーバーヘッドが各セル書き込みごとに発生するためです。

    • Accessでdb.BeginTrans / db.CommitTransやrs.BatchUpdatesを使用しない場合、各rs.Updateが即座にディスクI/Oを伴うため、処理時間は1秒～3秒以上に延びる可能性があります。

結果として、配列バッファとアプリケーション設定の最適化により、Excel/Accessともに処理速度が数倍から数十倍向上することが期待できます。

運用

実行方法

  • 手動実行: 開発者がVBEから直接実行するか、Officeアプリケーションのリボンにボタンを配置し、クリックイベントでマクロを実行します。

  • 定期実行: Windowsのタスクスケジューラを利用して、指定したOfficeファイルを開き、特定のVBAプロシージャを呼び出すことで定期的な情報収集が可能です。

    • 例: excel.exe "C:\Path\To\YourWorkbook.xlsm" /r "GetPCInfoToExcel" (起動時に指定したマクロを実行)

取得データの活用

  • 資産管理台帳: 取得したPC情報をExcelシートやAccessテーブルに集約し、社内PCの資産管理台帳として活用します。

  • レポート生成: 収集したデータを基に、各部署のPCスペック一覧やOSバージョン分布などのレポートを自動生成します。

  • 異常検知/監視: ディスク空き容量の急減、メモリ使用率の異常な上昇などを定期的に監視し、しきい値を超えた場合にアラートを出すシステムと連携します。

  • セキュリティ監査: 特定のセキュリティパッチの適用状況や、不正なソフトウェアの有無をWMIで確認し、セキュリティ監査に役立てます。

ロールバック方法

  • Excel: 新規シートに情報が出力されるため、問題が発生した場合はそのシートを削除するだけで済みます。既存のデータや設定には影響を与えません。

  • Access: 新規テーブルに情報が格納されるため、問題が発生した場合は作成されたテーブルを削除するだけで済みます。既存のテーブルやデータには影響を与えません。テーブル名は日付と時刻を含んでいるため、誤って既存テーブルを上書きするリスクも低いです。

セキュリティ考慮事項

  • WMIのアクセス権限: WMIは通常、管理者権限で動作します。非管理者ユーザーで実行する場合、必要なWMIクラスへのアクセス権限を事前に付与する必要があります。

  • コードの保護: VBAコードは容易に閲覧・改変される可能性があるため、配布時にはプロジェクトにパスワードを設定し、VBAコードを保護することを検討してください。

  • リモートPCからの情報取得: 他のPCからWMI経由で情報を取得する場合、ネットワークファイアウォールの設定、DCOMの設定、認証情報の取り扱い（ユーザー名/パスワードをハードコードしない）など、より高度なセキュリティ対策が必要になります。

落とし穴

  • WMIクエリの複雑化と性能劣化: 複雑なWMIクエリや、大量のWMIオブジェクトから多くのプロパティを取得する処理は、実行に時間がかかり性能を著しく低下させることがあります。必要な情報のみを厳選し、シンプルなクエリを心がけましょう。

  • リモートPCへのWMI接続時の問題: ファイアウォール、DCOM設定、適切な認証情報 (通常はSWbemLocatorとConnectServerメソッドで認証情報を渡す) の欠如などにより、リモートPCへの接続が失敗することがよくあります。これらの設定は事前に確認し、必要に応じて構成する必要があります。

  • Win32 APIの32bit/64bit互換性: Declareステートメントは、VBAのバージョンやOfficeのビット数 (32bit/64bit) によって記述が異なります。PtrSafeキーワードは64bit環境でのアドレスを正しく扱うために必須です。本記事のコードは #If VBA7 による条件付きコンパイルで対応していますが、古い環境で実行する場合は注意が必要です。特に LongLong 型が利用できない32bit VBA環境では、ULONGLONG を扱うために Currency を使うなどの回避策が必要になります。

  • エラーハンドリングの不備: ネットワーク障害、WMIサービスの停止、アクセス拒否など、様々な理由で情報取得が失敗する可能性があります。On Error GoTo を適切に使用し、予期せぬエラー発生時にもプログラムがクラッシュしないよう、堅牢なエラーハンドリングを実装することが重要です。

  • 取得情報の機微性: PC情報には、IPアドレスやMACアドレスなど、個人を特定可能な情報やネットワーク構成に関する情報が含まれる場合があります。これらの情報の取り扱いには、プライバシー保護や情報セキュリティに関する社内規定を遵守する必要があります。

まとめ

VBAとWMI、そしてWin32 APIを組み合わせることで、OfficeアプリケーションからPCのシステム情報を高度に取得し、自動化されたPC管理システムを構築することが可能です。本記事では、ExcelおよびAccessでの具体的な実装例を示し、性能最適化のためのテクニック（配列バッファ、画面更新停止、トランザクション利用）や、運用における考慮点、潜在的な落とし穴についても詳細に解説しました。

これらの知識と技術を活用することで、これまで手動で行っていたPC情報の収集・管理業務を劇的に効率化し、より正確で迅速な意思決定を支援できるでしょう。VBAによるOffice自動化は、ビジネスプロセス改善のための強力なツールとなり得ます。

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

コメント

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