VBAとWMIを活用したリモートPCのディスク空き容量一括照会ロジック

Tech

a1b2c3d4-e5f6-7890-1234-567890abcdef 2024-07-30T10:00:00Z 1.0.1 VBA_WMI_Remote_Disk_Query design_complete Excel_VBA_64bit

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

VBAとWMIを活用したリモートPCのディスク空き容量一括照会ロジック

【背景と目的】

多数のクライアントPCやサーバー群のディスク空き容量を定期監視する必要があるが、標準のネットワーク監視ツールは高価であり、pingやファイル共有による確認は遅く、ファイアウォールやアクセス権限のエラーに悩まされます。VBAからWMI（Windows Management Instrumentation）を利用することで、専用のライブラリ参照を必要とせず、集中管理された安全な方法で効率的に情報を収集します。

【処理フロー図】

graph TD
    A["開始: PC名リスト読み込み"] --> B{"ScreenUpdating=False 設定"};
    B --> C("リモートPC名リストをループ処理");
    C -->|PC名取得| D{"エラーハンドラON"};
    D --> E["WMIサービスに遅延バインディングで接続"];
    E -->|成功| F["Win32_LogicalDiskをクエリ"];
    F --> G{"結果セットを反復処理"};
    G --> H["空き容量・合計容量をGB換算"];
    H --> I["結果配列に出力データを格納"];
    G --> J{"ループ終了"};
    E -->|失敗| K["エラー情報(接続不可等)を結果配列に格納"];
    J --> L["結果配列をシートに一括書き出し"];
    L --> M["ScreenUpdating=True / エラーハンドラ解除"];
    M --> Z["終了"];

【実装：VBAコード】

本コードは、シートのA列に記載されたリモートPC名を読み込み、B列以降にディスク情報を一括出力します。WMIアクセスには、参照設定が不要な遅延バインディング（CreateObject）を使用します。

Option Explicit

' WMIのプロパティ値は通常、バイト単位で返されるため、GBに変換するための定数
Private Const GIGA_BYTE As Double = 1024# * 1024# * 1024#

Sub GetRemoteDiskSpace_WMI()

    ' 実行速度向上のための設定
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual ' 計算を手動に

    Dim wsTarget As Worksheet
    Set wsTarget = ThisWorkbook.Sheets("DiskQuery") ' 対象シート名に合わせて変更

    Dim lngRow As Long          ' データ行のインデックス
    Dim lngLastRow As Long      ' 最終行の取得
    Dim strPCName As String     ' リモートPC名

    ' WMIオブジェクト（遅延バインディング）
    Dim objSWbemLocator As Object ' WbemScripting.SWbemLocator
    Dim objWMIService As Object   ' SWbemServices
    Dim colDisks As Object        ' SWbemObjectSet
    Dim objDisk As Object         ' SWbemObject

    ' 結果格納用配列
    Dim vntPCList As Variant
    Dim vntResults() As Variant
    Dim lngResultIndex As Long

    ' 初期設定
    On Error GoTo ErrorHandler

    ' 1. PC名のリストを読み込み
    lngLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    If lngLastRow < 2 Then
        MsgBox "A列にPC名が入力されていません。", vbCritical
        GoTo CleanUp
    End If

    ' PC名リストを配列として取得 (ヘッダー行を除く)
    vntPCList = wsTarget.Range("A2:A" & lngLastRow).Value

    ' 結果配列の初期化 (最大数: PC数 * ディスク数 + 1列 (ヘッダー))
    ' 結果の列構成: PC名, ドライブ名, 合計容量(GB), 空き容量(GB), 空き容量(%)
    ReDim vntResults(1 To (lngLastRow - 1) * 5, 1 To 5)
    lngResultIndex = 1

    ' ヘッダー行の挿入
    vntResults(lngResultIndex, 1) = "PC名"
    vntResults(lngResultIndex, 2) = "ドライブ"
    vntResults(lngResultIndex, 3) = "合計容量(GB)"
    vntResults(lngResultIndex, 4) = "空き容量(GB)"
    vntResults(lngResultIndex, 5) = "空き容量(%)"
    lngResultIndex = lngResultIndex + 1

    ' SWbemLocatorのインスタンス作成（参照設定不要）
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")

    ' 2. リストをループ処理してWMI照会を実行
    For lngRow = LBound(vntPCList, 1) To UBound(vntPCList, 1)
        strPCName = Trim(CStr(vntPCList(lngRow, 1)))

        If strPCName = "" Then GoTo NextPC

        ' WMI接続サービスオブジェクトの取得
        ' Timeoutを考慮した実装が望ましいが、今回はシンプルに接続を試みる
        Set objWMIService = Nothing

        ' 接続試行（認証情報を渡さない場合は現在のユーザー権限を使用）
        Set objWMIService = objSWbemLocator.ConnectServer(strPCName, "root\cimv2")

        ' WMIクエリの実行
        ' DriveType=3 はローカルディスクを示す。
        Set colDisks = objWMIService.ExecQuery( _
            "SELECT DeviceID, Size, FreeSpace FROM Win32_LogicalDisk WHERE DriveType = 3")

        ' 結果セットの反復処理
        For Each objDisk In colDisks
            Dim dblTotalSizeGB As Double
            Dim dblFreeSpaceGB As Double
            Dim dblPercentFree As Double

            ' バイト値をGBに変換
            If Not IsNull(objDisk.Size) And objDisk.Size > 0 Then
                dblTotalSizeGB = objDisk.Size / GIGA_BYTE
                dblFreeSpaceGB = objDisk.FreeSpace / GIGA_BYTE

                ' 空き容量のパーセンテージ計算
                dblPercentFree = (objDisk.FreeSpace / objDisk.Size) * 100

                ' 結果配列に格納
                vntResults(lngResultIndex, 1) = strPCName
                vntResults(lngResultIndex, 2) = objDisk.DeviceID
                vntResults(lngResultIndex, 3) = Round(dblTotalSizeGB, 2)
                vntResults(lngResultIndex, 4) = Round(dblFreeSpaceGB, 2)
                vntResults(lngResultIndex, 5) = Round(dblPercentFree, 1) & "%"
                lngResultIndex = lngResultIndex + 1
            End If
        Next objDisk

NextPC:
        ' オブジェクトの解放 (早期に解放しメモリ負荷を軽減)
        Set objWMIService = Nothing
        On Error GoTo ErrorHandler ' エラーハンドラを再設定

    Next lngRow

    ' 3. 結果の出力
    ' 既存データ領域をクリア
    wsTarget.Range("B2:F" & wsTarget.Rows.Count).ClearContents

    ' 最終出力範囲を設定
    If lngResultIndex > 1 Then
        Dim rngOutput As Range
        Set rngOutput = wsTarget.Range("A1").Resize(lngResultIndex - 1, UBound(vntResults, 2))
        ' 配列を一括でシートに書き出す
        rngOutput.Value = vntResults

        ' データ部の書式設定
        wsTarget.Columns("C:D").NumberFormat = "0.00"
        wsTarget.Columns("E").NumberFormat = "0.0"
    End If

    MsgBox "リモートディスク容量照会が完了しました。", vbInformation

GoTo CleanUp

' --- エラー処理 ---
ErrorHandler:
    ' 接続エラーが発生した場合の処理
    If Err.Number <> 0 Then
        ' エラー情報を結果配列に格納
        vntResults(lngResultIndex, 1) = strPCName
        vntResults(lngResultIndex, 2) = "接続エラー"
        vntResults(lngResultIndex, 3) = "コード: " & Err.Number
        vntResults(lngResultIndex, 4) = "内容: " & Err.Description
        vntResults(lngResultIndex, 5) = "---"
        lngResultIndex = lngResultIndex + 1

        ' エラーを無視して次のPCへ
        Resume NextPC
    End If

' --- 後処理 ---
CleanUp:
    Set objDisk = Nothing
    Set colDisks = Nothing
    Set objWMIService = Nothing
    Set objSWbemLocator = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

【技術解説】

WMIと遅延バインディング

このVBAコードの核心は、WMI (Windows Management Instrumentation) の利用と、それを参照設定なしで行う遅延バインディングです。

  1. SWbemLocator (WbemScripting.SWbemLocator): これはWMIサービスへの接続を提供するオブジェクトです。CreateObject("WbemScripting.SWbemLocator") でインスタンス化することで、事前の参照設定（Microsoft WMI Scripting Library）が不要になります。

  2. ConnectServerメソッド: SWbemLocator の主要メソッドで、リモートPC名と名前空間（通常は "root\cimv2"）を指定してWMIサービスに接続します。これにより、リモートPCのOS管理情報にアクセスする権限を得ます。

  3. Win32_LogicalDisk: これは論理ディスク（パーティションやネットワークドライブなど）を表すWMIクラスです。今回のクエリでは、DriveType = 3 (ローカル固定ディスク) にフィルタリングし、Size（合計容量）と FreeSpace（空き容量）をバイト単位で取得しています。

高速化の理論

  • 配列処理 (vntResults): リモートアクセスはネットワーク遅延が大きいため、ExcelシートへのI/O処理は極力減らす必要があります。ここでは、すべての結果をメモリ上の配列 (vntResults) に格納し、ループ終了後に rngOutput.Value = vntResults で一括書き出しを行うことで、シートI/Oのオーバーヘッドを劇的に削減しています。

  • ScreenUpdating = False: 描画処理を停止し、処理時間を短縮しています。

【注意点と運用】

1. リモート接続の落とし穴：DCOM/ファイアウォール

WMIによるリモート接続は、内部的にはDCOM (Distributed Component Object Model) を使用します。接続に失敗する場合、以下のいずれかが原因であることが非常に多いです。

  • ファイアウォール: 対象PCのファイアウォールでWMIの通信ポート（通常、DCOMは動的ポートを使用）がブロックされている。解決策として、特定のインバウンド規則（WMI / Remote Administration）を有効にする必要があります。

  • アクセス権限: VBAを実行しているユーザーアカウントが、リモートPCの管理者権限またはWMIへのアクセス権限を持っていない。

  • サービス: リモートPCの “Windows Management Instrumentation” サービスが停止している。

回避策: エラーハンドラ内で接続エラー (Err.Number) を捕捉し、「接続エラー」として記録することで、処理の中断を防ぎ、後でエラー原因を調査できるようにします。

2. ネットワークタイムアウト

デフォルトのWMI接続はタイムアウト設定がルーズなため、応答のないPCがあると処理全体が長時間停止する可能性があります。

回避策: objSWbemLocator.Security_.ImpersonationLevel = 3 や objWMIService.Security_.AuthenticationLevel = 6 などのセキュリティ設定や、WMIクエリにタイムアウトオプション（VBAの標準機能では難しいが、WMIのAPIレベルで設定可能）を加えることで、応答速度を制御することが推奨されます。ただし、今回のシンプルコードでは、タイムアウトが発生しないよう、事前にネットワークが安定していることを確認してください。

【まとめ】

  1. 参照設定不要の遅延バインディング: CreateObject("WbemScripting.SWbemLocator") を使用することで、環境に依存せずWMI機能を利用できます。

  2. 配列による一括I/O: リモートアクセスの遅延を補うため、全ての計算結果を配列に格納してからシートへ書き出す方式を採用し、実行時間を短縮します。

  3. エラーハンドリングの徹底: リモートPCの接続失敗は日常茶飯事です。On Error GoTo を利用し、接続できないPCはスキップしつつ、その情報を記録に残す運用を徹底してください。

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

コメント

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