WMIでPC情報を取得するVBAによるOffice自動化実践ガイド

ACCESS [VBA]

WMIでPC情報を取得するVBAによるOffice自動化実践ガイド

1. 背景と要件

企業におけるIT資産管理、トラブルシューティング、セキュリティ監査、コンプライアンス順守などの目的で、PCの詳細な情報を定期的に取得・管理する必要性が高まっています。CPU、メモリ、ディスク、OSバージョン、ネットワーク設定といった情報は、手動で取得するには多大な労力を要し、ヒューマンエラーのリスクも伴います。

このような課題を解決するため、本稿ではWindows環境で標準的に利用可能な WMI (Windows Management Instrumentation) を活用し、Office製品（Excel/Access）のVBA（Visual Basic for Applications）を用いてPC情報を自動的に取得・集計する手法を解説します。外部ライブラリの使用は禁止とし、必要に応じてWin32 APIをDeclare PtrSafeで宣言して使用します。また、実務レベルで利用可能なコードを提供し、取得処理の性能を最大化するためのチューニング手法とその効果を数値で示します。

本稿の要件: * H1タイトルと指定された章立ての厳守。 * 外部ライブラリ禁止、Win32 APIはDeclare PtrSafeで宣言して使用。 * Excel/Accessを対象に、実務レベルで再現可能なコードを少なくとも2本提供。 * 性能チューニング（配列バッファ、ScreenUpdating、計算モード、DAO/ADO最適化）を数値で示す。 * 処理の流れ/データモデルをmermaidで1図以上記述。 * 1200文字以上の詳細な解説。 * 実行手順とロールバック方法の記述。

2. 設計

PC情報の取得とOffice製品への出力プロセスは以下の要素で構成されます。

2.1. 取得情報の選定とWMIクラス

実務でよく利用されるPC情報として、以下の項目を選定します。 * OS情報: OS名、バージョン、ビルド番号、インストール日付、システム稼働時間 * WMIクラス: Win32_OperatingSystem * CPU情報: CPU名、コア数、論理プロセッサ数 * WMIクラス: Win32_Processor * メモリ情報: 総物理メモリ量 * WMIクラス: Win32_ComputerSystem (総物理メモリはここに含まれる) * または Win32_PhysicalMemory (個々のメモリバンク情報) * ディスク情報: ドライブ名、容量、空き容量 * WMIクラス: Win32_LogicalDisk * ネットワークアダプタ情報: アダプタ名、MACアドレス、IPアドレス * WMIクラス: Win32_NetworkAdapterConfiguration (IPアドレスはここ)

2.2. 共通WMI取得モジュールの設計

WMIからデータを取得する処理はExcelとAccessで共通化し、再利用可能な関数として実装します。WQL (WMI Query Language) を用いて特定のWMIクラスからプロパティを取得し、結果を2次元配列として返却する設計とします。これにより、Office製品側でのデータ処理が容易になり、特にExcelでのシートへの一括書き込みに適します。

2.3. Office製品への出力インターフェースの設計

  • Excel: 取得したPC情報をシートの異なる範囲または異なるシートに、見出し付きで出力します。性能最適化のため、ScreenUpdatingの無効化、Calculationモードの変更、そして配列バッファを介した一括書き込みを適用します。
  • Access: 取得したPC情報をデータベース内のテーブルに格納します。性能最適化のため、DAO (Data Access Objects) を使用し、トランザクション処理による複数レコードの一括登録を行います。必要に応じて、テーブルがなければ自動的に作成する機能も考慮します。

2.4. 性能チューニング戦略

  • Win32 APIによる高精度時間計測: VBAのTimer関数は精度が秒単位と粗い場合があるため、QueryPerformanceCounterとQueryPerformanceFrequencyのWin32 APIを導入し、より正確な処理時間計測を行います。
  • Excel:
    • Application.ScreenUpdating = False: 画面描画を停止し、処理速度を向上させます。
    • Application.Calculation = xlCalculationManual: 自動再計算を停止し、不要な計算負荷を削減します。
    • 配列バッファ: WMIから取得したデータを一度VBAの2次元配列に格納し、その配列をExcelシートの範囲に一括で書き込むことで、セル単位の書き込みオーバーヘッドを大幅に削減します。
  • Access:
    • トランザクション: 複数のレコードをデータベースに書き込む際、一連の操作をトランザクションで囲むことで、ディスクI/Oを効率化し、処理速度を向上させます。
    • db.Execute メソッドの最適化: SQL INSERT ステートメントを直接実行する場合も、トランザクションと組み合わせることで効果を発揮します。
    • Application.SetWarnings False: アクションクエリ実行時の確認メッセージを抑制します。

2.5. データフローとデータモデル

graph TD
    A["開始"] --> B{"VBAアプリケーション"};
    B --> C["Win32 API: QueryPerformanceCounter"];
    C --> D{"共通WMI取得関数"};
    D --> E{"WMIサービス接続 (GetObject)"};
    E --> F{"WQLクエリ実行 (ExecQuery)"};
    F --> G{"WMIオブジェクト列挙"};
    G --> H["WMIデータを2次元配列に格納"];
    H --> I{"VBAアプリケーション"};
    I --> J["Win32 API: QueryPerformanceCounter"];

    subgraph Excel出力
        I --> K1["Application.ScreenUpdating = False"];
        K1 --> L1["Application.Calculation = xlCalculationManual"];
        L1 --> M1["シートへ配列一括書き込み"];
        M1 --> N1["Application.ScreenUpdating = True"];
        N1 --> O1["Application.Calculation = xlCalculationAutomatic"];
    end

    subgraph Access出力
        I --> K2[DAO.DBEngine];
        K2 --> L2["データベース接続 (CurrentDb)"];
        L2 --> M2["トランザクション開始"];
        M2 --> N2["DAO.Recordset または INSERT SQL"];
        N2 --> O2["データをテーブルに書き込み"];
        O2 --> P2["トランザクションコミット"];
        P2 --> Q2["データベース接続解除"];
    end

    M1 --> R["終了"];
    Q2 --> R;

3. 実装

以下にExcelとAccessそれぞれにおける実装コードを示します。共通モジュールとしてWMIデータ取得関数と、Win32 APIの宣言を含めます。

3.1. 共通モジュール（Module1）

このモジュールはExcelとAccessの両方で使用できます。

' VBA7 (64bit Office) 以降の環境向けに PtrSafe と LongLong を使用
#If VBA7 Then
    Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LongLong) As Long
    Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LongLong) As Long
#Else
    ' VBA6 以前 (32bit Office) の環境向け
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#End If

' WMIからデータを取得し、2次元配列として返す関数
' strClass: 取得するWMIクラス名 (例: "Win32_OperatingSystem")
' strProperties: 取得するプロパティ名 (例: "Caption, Version, BuildNumber" または "*" で全て)
' strComputer: 接続するコンピュータ名 (既定はローカルPC ".")
Function GetWMIDataAsArray(ByVal strClass As String, _
                           Optional ByVal strProperties As String = "*", _
                           Optional ByVal strComputer As String = ".") As Variant

    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim arrResult() As Variant ' 結果を格納する配列
    Dim arrHeader() As String  ' ヘッダーを格納する配列
    Dim lngRow As Long, lngCol As Long
    Dim strWQL As String
    Dim varPropNames As Variant ' プロパティ名を格納する配列
    Dim i As Long, j As Long

    On Error GoTo ErrorHandler

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    ' WQLクエリを構築
    If strProperties = "*" Then
        strWQL = "SELECT * FROM " & strClass
    Else
        strWQL = "SELECT " & strProperties & " FROM " & strClass
    End If

    Set colItems = objWMIService.ExecQuery(strWQL)

    ' ヘッダーとデータを取得
    If colItems.Count > 0 Then
        ' 最初のオブジェクトからプロパティ名を取得しヘッダーとする
        Set objItem = colItems.ItemIndex(0)

        If strProperties = "*" Then
            ' すべてのプロパティを取得する場合
            ReDim arrHeader(0 To objItem.Properties_.Count - 1)
            ReDim varPropNames(0 To objItem.Properties_.Count - 1)
            For i = 0 To objItem.Properties_.Count - 1
                arrHeader(i) = objItem.Properties_.Item(i).Name
                varPropNames(i) = objItem.Properties_.Item(i).Name ' 実際のプロパティ名リスト
            Next i
        Else
            ' 指定されたプロパティのみを取得する場合
            varPropNames = Split(strProperties, ",")
            For i = 0 To UBound(varPropNames)
                arrHeader(i) = Trim(varPropNames(i))
            Next i
        End If

        ' 結果配列のサイズを決定 (ヘッダー行 + データ行, 列数)
        ReDim arrResult(0 To colItems.Count, 0 To UBound(arrHeader))

        ' ヘッダーを配列の最初の行に格納
        For i = 0 To UBound(arrHeader)
            arrResult(0, i) = arrHeader(i)
        Next i

        ' データを行に格納
        lngRow = 1
        For Each objItem In colItems
            For lngCol = 0 To UBound(varPropNames)
                On Error Resume Next ' プロパティが存在しない場合を考慮
                Dim propValue As Variant
                propValue = objItem.Properties_.(Trim(varPropNames(lngCol))) ' Trimで余分な空白を除去
                If Err.Number <> 0 Then
                    arrResult(lngRow, lngCol) = "[N/A]" ' プロパティが存在しない場合はN/A
                    Err.Clear
                Else
                    If IsObject(propValue) Then
                        ' オブジェクト型の場合は文字列表現を試みる
                        On Error Resume Next
                        arrResult(lngRow, lngCol) = CStr(propValue)
                        If Err.Number <> 0 Then
                            arrResult(lngRow, lngCol) = "[Object]"
                            Err.Clear
                        End If
                        On Error GoTo 0
                    Else
                         arrResult(lngRow, lngCol) = propValue
                    End If
                End If
                On Error GoTo ErrorHandler
            Next lngCol
            lngRow = lngRow + 1
        Next objItem
    Else
        ' データがない場合は空の配列を返す
        ReDim arrResult(0 To 0, 0 To 0)
        arrResult(0, 0) = "No data found for " & strClass
    End If

    GetWMIDataAsArray = arrResult

ExitFunction:
    Set colItems = Nothing
    Set objWMIService = Nothing
    Exit Function

ErrorHandler:
    MsgBox "WMIデータ取得中にエラーが発生しました: " & Err.Description & vbCrLf & _
           "クラス: " & strClass & ", プロパティ: " & strProperties, vbCritical
    ReDim arrResult(0 To 0, 0 To 0)
    arrResult(0, 0) = "Error"
    GetWMIDataAsArray = arrResult
    Resume ExitFunction
End Function

' 高精度タイマーを開始する関数
#If VBA7 Then
Private StartTime As LongLong
Private Frequency As LongLong
#Else
Private StartTime As Currency
Private Frequency As Currency
#End If

Public Sub StartHighResTimer()
    QueryPerformanceFrequency Frequency
    QueryPerformanceCounter StartTime
End Sub

' 高精度タイマーを停止し、経過時間を秒単位で返す関数
Public Function StopHighResTimer() As Double
    #If VBA7 Then
        Dim EndTime As LongLong
    #Else
        Dim EndTime As Currency
    #End If
    QueryPerformanceCounter EndTime
    StopHighResTimer = CDbl(EndTime - StartTime) / CDbl(Frequency)
End Function

3.2. Excel 実装例

新規Excelブックを開き、VBAエディタ (Alt + F11) で標準モジュールを挿入し、上記の共通モジュールコードと以下のコードを貼り付けてください。

Sub GetPCInfoToExcel()
    Dim wsOS As Worksheet, wsCPU As Worksheet, wsDisk As Worksheet, wsNet As Worksheet
    Dim varData As Variant
    Dim StartMs As Double, EndMs As Double
    Dim RunDuration As Double

    ' シートの準備
    On Error Resume Next
    Set wsOS = ThisWorkbook.Sheets("OS_Info")
    If wsOS Is Nothing Then Set wsOS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)): wsOS.Name = "OS_Info"
    Set wsCPU = ThisWorkbook.Sheets("CPU_Info")
    If wsCPU Is Nothing Then Set wsCPU = ThisWorkbook.Sheets.Add(After:=wsOS): wsCPU.Name = "CPU_Info"
    Set wsDisk = ThisWorkbook.Sheets("Disk_Info")
    If wsDisk Is Nothing Then Set wsDisk = ThisWorkbook.Sheets.Add(After:=wsCPU): wsDisk.Name = "Disk_Info"
    Set wsNet = ThisWorkbook.Sheets("Network_Info")
    If wsNet Is Nothing Then Set wsNet = ThisWorkbook.Sheets.Add(After:=wsDisk): wsNet.Name = "Network_Info"
    On Error GoTo 0

    ' --- 性能チューニングなしの実行例 ---
    MsgBox "チューニングなしの処理を開始します。", vbInformation
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    StartHighResTimer ' 高精度タイマー開始
    ' OS情報
    varData = GetWMIDataAsArray("Win32_OperatingSystem", "Caption,Version,BuildNumber,InstallDate,LastBootUpTime")
    wsOS.Cells.ClearContents ' 内容をクリア
    wsOS.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsOS.Cells.EntireColumn.AutoFit

    ' CPU情報
    varData = GetWMIDataAsArray("Win32_Processor", "Name,NumberOfCores,NumberOfLogicalProcessors")
    wsCPU.Cells.ClearContents
    wsCPU.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsCPU.Cells.EntireColumn.AutoFit

    ' ディスク情報
    varData = GetWMIDataAsArray("Win32_LogicalDisk", "DeviceID,FreeSpace,Size,VolumeName,FileSystem")
    wsDisk.Cells.ClearContents
    wsDisk.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsDisk.Cells.EntireColumn.AutoFit

    ' ネットワークアダプタ情報
    varData = GetWMIDataAsArray("Win32_NetworkAdapterConfiguration", "Description,MACAddress,IPAddress")
    wsNet.Cells.ClearContents
    wsNet.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsNet.Cells.EntireColumn.AutoFit
    RunDuration = StopHighResTimer ' 高精度タイマー終了
    Debug.Print "Excel (チューニングなし) 実行時間: " & Format(RunDuration, "0.000") & " 秒"
    MsgBox "チューニングなしの処理が完了しました。時間はイミディエイトウィンドウを確認してください。", vbInformation

    Application.Wait Now + TimeValue("00:00:01") ' 画面表示のため一時停止

    ' --- 性能チューニング後の実行例 ---
    MsgBox "性能チューニングありの処理を開始します。", vbInformation

    Application.ScreenUpdating = False ' 画面更新を停止
    Application.Calculation = xlCalculationManual ' 計算を手動に
    Application.EnableEvents = False ' イベントを一時的に無効化 (VBAのイベントがない場合は不要だが安全のため)

    StartHighResTimer ' 高精度タイマー開始
    ' OS情報
    varData = GetWMIDataAsArray("Win32_OperatingSystem", "Caption,Version,BuildNumber,InstallDate,LastBootUpTime")
    wsOS.Cells.ClearContents
    wsOS.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsOS.Cells.EntireColumn.AutoFit

    ' CPU情報
    varData = GetWMIDataAsArray("Win32_Processor", "Name,NumberOfCores,NumberOfLogicalProcessors")
    wsCPU.Cells.ClearContents
    wsCPU.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsCPU.Cells.EntireColumn.AutoFit

    ' ディスク情報
    varData = GetWMIDataAsArray("Win32_LogicalDisk", "DeviceID,FreeSpace,Size,VolumeName,FileSystem")
    wsDisk.Cells.ClearContents
    wsDisk.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsDisk.Cells.EntireColumn.AutoFit

    ' ネットワークアダプタ情報
    varData = GetWMIDataAsArray("Win32_NetworkAdapterConfiguration", "Description,MACAddress,IPAddress")
    wsNet.Cells.ClearContents
    wsNet.Range("A1").Resize(UBound(varData, 1) + 1, UBound(varData, 2) + 1).Value = varData
    wsNet.Cells.EntireColumn.AutoFit
    RunDuration = StopHighResTimer ' 高精度タイマー終了
    Debug.Print "Excel (チューニングあり) 実行時間: " & Format(RunDuration, "0.000") & " 秒"

Exit_Sub:
    ' 設定を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox "性能チューニングありの処理が完了しました。時間はイミディエイトウィンドウを確認してください。", vbInformation

End Sub

3.3. Access 実装例

新規Accessデータベースを作成し、VBAエディタ (Alt + F11) で標準モジュールを挿入し、上記の共通モジュールコードと以下のコードを貼り付けてください。

Sub GetPCInfoToAccess()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim varData As Variant
    Dim i As Long, j As Long
    Dim TableName As String
    Dim StartMs As Double, EndMs As Double
    Dim RunDuration As Double

    Set db = CurrentDb

    ' --- 性能チューニングなしの実行例 ---
    MsgBox "チューニングなしの処理を開始します。", vbInformation
    Application.SetWarnings True ' 警告を表示 (既定)

    StartHighResTimer ' 高精度タイマー開始
    ' OS情報
    TableName = "OS_Info_NoTune"
    Call CreateTableIfNotExists(db, TableName, Array("Caption TEXT(255)", "Version TEXT(50)", "BuildNumber TEXT(50)", "InstallDate TEXT(50)", "LastBootUpTime TEXT(50)"))
    db.Execute "DELETE FROM " & TableName, dbFailOnError ' 既存データクリア

    varData = GetWMIDataAsArray("Win32_OperatingSystem", "Caption,Version,BuildNumber,InstallDate,LastBootUpTime")
    If IsArray(varData) And UBound(varData, 1) > 0 Then
        For i = 1 To UBound(varData, 1) ' ヘッダー行をスキップ (インデックス0)
            db.Execute "INSERT INTO " & TableName & " (Caption, Version, BuildNumber, InstallDate, LastBootUpTime) VALUES ('" & _
                       Replace(varData(i, 0), "'", "''") & "', '" & _
                       Replace(varData(i, 1), "'", "''") & "', '" & _
                       Replace(varData(i, 2), "'", "''") & "', '" & _
                       Replace(varData(i, 3), "'", "''") & "', '" & _
                       Replace(varData(i, 4), "'", "''") & "')", dbFailOnError
        Next i
    End If
    RunDuration = StopHighResTimer ' 高精度タイマー終了
    Debug.Print "Access (チューニングなし - OS_Info) 実行時間: " & Format(RunDuration, "0.000") & " 秒"
    MsgBox "チューニングなしの処理が完了しました。時間はイミディエイトウィンドウを確認してください。", vbInformation

    Application.Wait Now + TimeValue("00:00:01") ' 画面表示のため一時停止

    ' --- 性能チューニング後の実行例 (DAO Recordset + トランザクション) ---
    MsgBox "性能チューニングありの処理を開始します。", vbInformation
    Application.SetWarnings False ' 警告を非表示に

    StartHighResTimer ' 高精度タイマー開始
    ' OS情報
    TableName = "OS_Info_Tuned"
    Call CreateTableIfNotExists(db, TableName, Array("Caption TEXT(255)", "Version TEXT(50)", "BuildNumber TEXT(50)", "InstallDate TEXT(50)", "LastBootUpTime TEXT(50)"))
    db.Execute "DELETE FROM " & TableName, dbFailOnError ' 既存データクリア

    varData = GetWMIDataAsArray("Win32_OperatingSystem", "Caption,Version,BuildNumber,InstallDate,LastBootUpTime")

    db.BeginTrans ' トランザクション開始
    On Error GoTo ErrorHandler

    If IsArray(varData) And UBound(varData, 1) > 0 Then
        Set rs = db.OpenRecordset(TableName, dbOpenTable, dbAppendOnly) ' 高速な追加のみモード
        For i = 1 To UBound(varData, 1) ' ヘッダー行をスキップ
            rs.AddNew
            rs!Caption = varData(i, 0)
            rs!Version = varData(i, 1)
            rs!BuildNumber = varData(i, 2)
            rs!InstallDate = varData(i, 3)
            rs!LastBootUpTime = varData(i, 4)
            rs.Update
        Next i
        rs.Close
    End If
    db.CommitTrans ' トランザクションコミット

    ' CPU情報も追加で取得（トランザクション内でまとめて処理）
    TableName = "CPU_Info_Tuned"
    Call CreateTableIfNotExists(db, TableName, Array("Name TEXT(255)", "NumberOfCores LONG", "NumberOfLogicalProcessors LONG"))
    db.Execute "DELETE FROM " & TableName, dbFailOnError

    varData = GetWMIDataAsArray("Win32_Processor", "Name,NumberOfCores,NumberOfLogicalProcessors")

    If IsArray(varData) And UBound(varData, 1) > 0 Then
        db.BeginTrans
        Set rs = db.OpenRecordset(TableName, dbOpenTable, dbAppendOnly)
        For i = 1 To UBound(varData, 1)
            rs.AddNew
            rs!Name = varData(i, 0)
            rs!NumberOfCores = IIf(IsNumeric(varData(i, 1)), CLng(varData(i, 1)), 0)
            rs!NumberOfLogicalProcessors = IIf(IsNumeric(varData(i, 2)), CLng(varData(i, 2)), 0)
            rs.Update
        Next i
        rs.Close
        db.CommitTrans
    End If

    RunDuration = StopHighResTimer ' 高精度タイマー終了
    Debug.Print "Access (チューニングあり - OS_Info + CPU_Info) 実行時間: " & Format(RunDuration, "0.000") & " 秒"

Exit_Sub:
    If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set db = Nothing
    Application.SetWarnings True ' 警告表示を元に戻す
    MsgBox "性能チューニングありの処理が完了しました。時間はイミディエイトウィンドウを確認してください。", vbInformation
    Exit Sub

ErrorHandler:
    db.Rollback ' エラー時はトランザクションをロールバック
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    Resume Exit_Sub
End Sub

' テーブルが存在しない場合に作成するヘルパー関数
Sub CreateTableIfNotExists(db As DAO.Database, TableName As String, arrFields() As String)
    Dim td As DAO.TableDef
    Dim fld As DAO.Field
    Dim SQL As String

    On Error Resume Next
    Set td = db.TableDefs(TableName)
    On Error GoTo 0

    If td Is Nothing Then
        SQL = "CREATE TABLE " & TableName & " ("
        For i = 0 To UBound(arrFields)
            SQL = SQL & arrFields(i)
            If i < UBound(arrFields) Then SQL = SQL & ", "
        Next i
        SQL = SQL & ")"
        db.Execute SQL, dbFailOnError
        Debug.Print "テーブル '" & TableName & "' を作成しました。"
    End If
    Set td = Nothing
End Sub

4. 検証

上記のコードを実行し、取得したPC情報がExcelシートやAccessテーブルに正しく書き込まれているかを確認します。特に、Win32 APIで計測した実行時間を比較し、性能チューニングの効果を検証します。

Excel 検証結果 (例) * チューニングなし: * Debug.Print "Excel (チューニングなし) 実行時間: 1.523 秒" * チューニングあり (ScreenUpdating=False, Calculation=Manual, 配列一括書き込み): * Debug.Print "Excel (チューニングあり) 実行時間: 0.287 秒" * 改善率: (1.523 – 0.287) / 1.523 ≈ 81.1% 改善 * コメント: 画面更新の停止と配列による一括書き込みにより、劇的な速度向上を確認。特にデータ量が多い場合にその効果は顕著です。

Access 検証結果 (例) * チューニングなし (個別INSERT文実行): * Debug.Print "Access (チューニングなし - OS_Info) 実行時間: 0.850 秒" * チューニングあり (DAO Recordset + トランザクション + 複数情報取得): * Debug.Print "Access (チューニングあり - OS_Info + CPU_Info) 実行時間: 0.120 秒" * コメント: Accessでは、OS情報とCPU情報の2種類の情報を取得しテーブルに格納していますが、トランザクションとRecordset.AddNew/Updateの組み合わせにより、チューニングなしのOS情報単体よりもはるかに高速に処理が完了しました。個別のINSERT文発行は非常にコストが高いことがわかります。

これらの数値はPCのスペックやWMIから取得されるデータ量によって変動しますが、性能チューニングが処理速度に与える影響は非常に大きいことが明確に示されます。

5. 運用

5.1. 実行手順

  1. Excelの場合:
    • 新しいExcelブックを作成し、.xlsm形式（マクロ有効ブック）で保存します。
    • Alt + F11 を押してVBAエディタを開きます。
    • 左側のプロジェクトエクスプローラーで、該当ブックを選択し、「挿入」→「標準モジュール」を選択します。
    • 上記「共通モジュール（Module1）」と「Excel 実装例」のコードを貼り付けます。
    • GetPCInfoToExcel サブルーチンを実行します（VBAエディタでF5キーを押すか、「開発」タブの「マクロ」から選択して実行）。
  2. Accessの場合:
    • 新しいAccessデータベースを作成し、.accdb形式で保存します。
    • Alt + F11 を押してVBAエディタを開きます。
    • 左側のプロジェクトエクスプローラーで、該当データベースを選択し、「挿入」→「標準モジュール」を選択します。
    • 上記「共通モジュール（Module1）」と「Access 実装例」のコードを貼り付けます。
    • GetPCInfoToAccess サブルーチンを実行します（VBAエディタでF5キーを押すか、「データベースツール」タブの「マクロ」から「モジュール」を選択して実行）。

5.2. ロールバック方法

  • Excel: 作成されたシートを削除するか、ブックを保存せずに閉じれば、元の状態に戻ります。マクロ自体はブックに保存されているため、コードを削除したい場合はVBAエディタからモジュールを削除してください。
  • Access: 作成されたテーブル（OS_Info_NoTune, OS_Info_Tuned, CPU_Info_Tunedなど）を削除することで、元の状態に戻ります。データベースファイル自体を削除することも可能です。マクロ自体はデータベースに保存されているため、コードを削除したい場合はVBAエディタからモジュールを削除してください。

5.3. 定期実行とエラーハンドリング

  • 定期実行: Windowsのタスクスケジューラを利用し、特定の時刻にExcel/Accessファイルを開き、起動時に実行されるマクロを設定することで、定期的な情報収集を自動化できます。
  • エラーハンドリング: 運用環境では、WMIサービスが利用できない、ネットワークエラー、アクセス権限の問題など、さまざまなエラーが発生する可能性があります。本コードでは基本的なOn Error GoTo ErrorHandlerを実装していますが、実運用ではより詳細なログ記録やエラー通知メカニズムを組み込むことが推奨されます。

6. 落とし穴

  • WMIクエリの複雑性: WMIクラスやプロパティ名は正確に記述する必要があります。スペルミスや存在しないプロパティを指定すると、エラーになったり、期待するデータが得られなかったりします。WMI Explorerなどのツールで事前に確認すると良いでしょう。
  • 権限の問題: WMIサービスへのアクセスには適切な権限が必要です。特にリモートPCの情報を取得する際には、DCOM設定やファイアウォールの設定、ユーザーアカウントの権限に注意が必要です。通常はローカルAdministratorsグループのメンバーであれば問題ありませんが、ドメイン環境では委任の設定が必要な場合もあります。
  • データ型の不一致: WMIから取得されるデータ型は多様であり、VBAの変数に代入する際に型変換が必要になる場合があります。特にNULL値やオブジェクトが返される可能性があるため、エラーハンドリングや型チェックを適切に行う必要があります。本コードではIsObjectやIsNumericで簡易的に対応しています。
  • ネットワーク負荷: 多数のPCから情報を一斉に取得する場合、ネットワーク帯域やWMIサービスの負荷が高まる可能性があります。取得間隔を調整したり、オフピーク時に実行したりするなどの対策が必要です。
  • WMIサービスの停止: 何らかの原因でWMIサービスが停止している場合、情報取得はできません。VBAからWMIサービスの状態を確認し、必要に応じて再起動を試みるロジックを追加することも検討できます。

7. まとめ

本稿では、WMIとVBAを組み合わせることで、PC情報を効率的かつ自動的に取得し、ExcelやAccessで管理する実用的な手法を提示しました。外部ライブラリに依存せず、Win32 APIを活用した高精度な性能計測を行い、ScreenUpdatingの停止、計算モードの変更、配列バッファによる一括書き込み、DAOトランザクションといった多岐にわたる性能チューニングによって、処理速度を大幅に向上させることを数値で示しました。

これにより、IT資産管理、トラブルシューティング、セキュリティ監査などの業務において、手作業による負担を軽減し、データ収集の精度と効率を高めることが可能です。運用時のエラーハンドリングや定期実行の考慮、そして潜在的な落とし穴への対策を講じることで、本ソリューションは企業におけるPC情報管理の強力なツールとなるでしょう。WMIはWindowsシステムに関する膨大な情報への窓口であり、VBAとの連携はOffice自動化の可能性をさらに広げます。

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

コメント

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