VBAとCIMでネットワークアダプタ情報を取得・管理する実践ガイド

ACCESS【VBA】
2025.09.27

VBAとCIM（WMI）を活用したネットワークアダプタ情報の取得は、Office環境における資産管理、セキュリティ監査、トラブルシューティングの自動化において非常に有効な手段です。外部ツールに依存せず、Windowsが提供する豊富なシステム情報にアクセスできるため、多くの実務で応用が可能です。本稿では、ExcelとAccessを対象に、実務レベルで再現可能なコードと性能チューニングの手法を詳述します。

VBAとCIMでネットワークアダプタ情報を取得・管理する実践ガイド

背景と要件

多くの企業や組織では、PCのネットワーク設定、特にIPアドレス、MACアドレス、接続状態などを効率的に管理する必要に迫られています。手動での情報収集は時間がかかり、人的ミスも発生しやすいため、自動化が求められています。

本稿の要件は以下の通りです。 1. Officeアプリケーションからの情報取得: ExcelまたはAccessからネットワークアダプタの情報を取得する。 2. 外部ライブラリ不使用: 標準のVBA機能とWindows Management Instrumentation (WMI) のCOMインターフェースのみを使用し、必要に応じてWin32 APIを Declare PtrSafe で宣言して利用する。 3. 主要情報の取得: アダプタ名、MACアドレス、IPアドレス、サブネットマスク、デフォルトゲートウェイ、DHCP有効/無効、接続状態などの主要情報を取得する。 4. 性能チューニング: 大量のデータを扱う場合でも高速に処理できるよう、配列バッファ、ScreenUpdating無効化、計算モード変更、DAO/ADO最適化などの手法を適用し、その効果を数値で示す。 5. 再現可能なコード: 実務で即利用できるよう、Excel用とAccess用の具体的なVBAコードを提示する。 6. 可視化: 処理の流れをMermaid図で示す。 7. 詳細な解説: 実行手順、ロールバック方法、落とし穴と対策まで含め、1200字以上の記事として記述する。

設計

ネットワークアダプタ情報はWindows Management Instrumentation (WMI) を通じてアクセスできます。WMIはCIM (Common Information Model) を基盤としており、OSやハードウェアに関する詳細な情報を提供します。

データソース

  • Win32_NetworkAdapterConfiguration: IPアドレス、DHCP設定、DNS設定、ゲートウェイなど、ネットワーク構成に関する情報を提供します。IPEnabledプロパティがTrueのアダプタを対象とします。
  • Win32_NetworkAdapter: MACアドレス、アダプタ名、接続状態、速度など、物理アダプタの基本情報を提供します。

これら二つのWMIクラスを組み合わせることで、包括的なネットワークアダプタ情報を取得します。Win32_NetworkAdapterConfigurationのIndexプロパティとWin32_NetworkAdapterのIndexプロパティを紐づけることで、両方の情報を結合します。

データモデル

取得する情報の例： – Description: アダプタの名前 (例: “Intel(R) Ethernet Connection…”) – MACAddress: 物理アドレス – IPAddress: IPアドレス (配列) – IPSubnet: サブネットマスク (配列) – DefaultIPGateway: デフォルトゲートウェイ (配列) – DHCPEnabled: DHCPが有効か (True/False) – DHCPServer: DHCPサーバーのIPアドレス – NetConnectionStatus: 接続状態 (0:切断, 1:接続, 2:無効, …) – Manufacturer: 製造元 – Speed: 接続速度 (ビット/秒)

これらの情報をVariant型の二次元配列に格納し、最終的にExcelシートまたはAccessテーブルに出力します。

処理フロー (Mermaid)

graph TD
    A["VBAスクリプト開始"] --> B{"Application最適化"};
    B --> C["WMIサービスに接続"];
    C --> D["Win32_NetworkAdapterConfiguration クエリ実行"];
    D --> E["Win32_NetworkAdapter クエリ実行"];
    E --> F{"WMIオブジェクトから情報抽出"};
    F --> G["二次元配列にデータ格納"];
    G --> H{"Excel/Accessへの出力"};
    H -- Excel --> I["シートに配列一括書き込み"];
    H -- Access --> J["トランザクション内でテーブルにレコード追加"];
    I --> K{"Application設定復元"};
    J --> K;
    K --> L["処理時間計測・表示"];
    L --> M["VBAスクリプト終了"];

実装

Win32 APIとしてGetTickCountを宣言し、処理時間の計測に用います。共通モジュールとしてWMIからのデータ取得ロジックを実装し、ExcelとAccessからそれぞれ呼び出します。

共通モジュール (例: modNetworkInfo.bas)

' Win32 APIをDeclare PtrSafeで宣言し、処理時間の計測に利用
#If VBA7 Then
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
    Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If

Public Function GetNetworkAdapterInformation() As Variant
    Dim objWMILocator As Object
    Dim objWMIService As Object
    Dim objNetAdapterConfigSet As Object
    Dim objNetAdapterSet As Object
    Dim objConfig As Object
    Dim objAdapter As Object
    Dim colData As Collection
    Dim vResult() As Variant
    Dim lRow As Long
    Dim lCol As Long
    Dim vHeader As Variant
    Dim arrConfigData As Variant
    Dim arrAdapterData As Variant
    Dim dicAdapters As Object
    Dim strPnPDeviceID As String

    Set colData = New Collection
    Set dicAdapters = CreateObject("Scripting.Dictionary")

    On Error GoTo ErrorHandler

    ' WMIサービスに接続
    Set objWMILocator = CreateObject("WbemScripting.SWbemLocator")
    Set objWMIService = objWMILocator.ConnectServer(".", "root\cimv2")

    ' Win32_NetworkAdapterConfiguration から情報を取得
    Set objNetAdapterConfigSet = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = TRUE")

    ' Win32_NetworkAdapter からMACアドレスとPnPDeviceIDを辞書に格納
    Set objNetAdapterSet = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapter")
    For Each objAdapter In objNetAdapterSet
        ' PnPDeviceID をキーとして、MACアドレスとNetConnectionStatusを格納
        ' IPConfigとの結合キーとして使用
        strPnPDeviceID = GetWMIProperty(objAdapter, "PnPDeviceID")
        If strPnPDeviceID <> "" Then
            If Not dicAdapters.Exists(strPnPDeviceID) Then
                Set dicAdapters(strPnPDeviceID) = CreateObject("Scripting.Dictionary")
            End If
            dicAdapters(strPnPDeviceID)("MACAddress") = GetWMIProperty(objAdapter, "MACAddress")
            dicAdapters(strPnPDeviceID)("NetConnectionStatus") = GetWMIProperty(objAdapter, "NetConnectionStatus")
            dicAdapters(strPnPDeviceID)("Description") = GetWMIProperty(objAdapter, "Description")
            dicAdapters(strPnPDeviceID)("Manufacturer") = GetWMIProperty(objAdapter, "Manufacturer")
            dicAdapters(strPnPDeviceID)("Speed") = GetWMIProperty(objAdapter, "Speed")
        End If
    Next

    ' ヘッダー行を定義
    vHeader = Array("アダプタ名", "MACアドレス", "IPアドレス", "サブネットマスク", _
                    "デフォルトゲートウェイ", "DHCP有効", "DHCPサーバー", "接続状態", _
                    "製造元", "速度(bps)")
    colData.Add vHeader

    ' 取得した情報をコレクションに格納
    For Each objConfig In objNetAdapterConfigSet
        Dim vIPAddress As Variant, vSubnet As Variant, vGateway As Variant
        Dim vDNSServer As Variant
        Dim strCurrentPnPDeviceID As String
        Dim dicAdapterInfo As Object

        strCurrentPnPDeviceID = GetWMIProperty(objConfig, "PnPDeviceID")

        Set dicAdapterInfo = Nothing
        If dicAdapters.Exists(strCurrentPnPDeviceID) Then
            Set dicAdapterInfo = dicAdapters(strCurrentPnPDeviceID)
        End If

        vIPAddress = GetWMIProperty(objConfig, "IPAddress")
        vSubnet = GetWMIProperty(objConfig, "IPSubnet")
        vGateway = GetWMIProperty(objConfig, "DefaultIPGateway")
        vDNSServer = GetWMIProperty(objConfig, "DNSServerSearchOrder") ' 今回は出力しないが取得例

        colData.Add Array( _
            IIf(Not dicAdapterInfo Is Nothing, dicAdapterInfo("Description"), GetWMIProperty(objConfig, "Description")), _
            IIf(Not dicAdapterInfo Is Nothing, dicAdapterInfo("MACAddress"), "N/A"), _
            IIf(IsArray(vIPAddress), Join(vIPAddress, ", "), ""), _
            IIf(IsArray(vSubnet), Join(vSubnet, ", "), ""), _
            IIf(IsArray(vGateway), Join(vGateway, ", "), ""), _
            IIf(GetWMIProperty(objConfig, "DHCPEnabled"), "Yes", "No"), _
            GetWMIProperty(objConfig, "DHCPServer"), _
            GetConnectionStatusDescription(IIf(Not dicAdapterInfo Is Nothing, dicAdapterInfo("NetConnectionStatus"), -1)), _
            IIf(Not dicAdapterInfo Is Nothing, dicAdapterInfo("Manufacturer"), "N/A"), _
            IIf(Not dicAdapterInfo Is Nothing, dicAdapterInfo("Speed"), 0) _
        )
    Next

    ' コレクションを二次元配列に変換
    If colData.Count > 0 Then
        ReDim vResult(1 To colData.Count, 1 To UBound(vHeader) + 1)
        For lRow = 1 To colData.Count
            arrConfigData = colData(lRow)
            For lCol = 1 To UBound(arrConfigData) + 1
                vResult(lRow, lCol) = arrConfigData(lCol - 1)
            Next lCol
        Next lRow
    Else
        ReDim vResult(1 To 1, 1 To UBound(vHeader) + 1)
        vResult(1, 1) = "データなし"
    End If
    GetNetworkAdapterInformation = vResult

Exit_Function:
    ' オブジェクトの解放
    Set objConfig = Nothing
    Set objAdapter = Nothing
    Set objNetAdapterConfigSet = Nothing
    Set objNetAdapterSet = Nothing
    Set objWMIService = Nothing
    Set objWMILocator = Nothing
    Set dicAdapters = Nothing
    Set colData = Nothing
    Exit Function

ErrorHandler:
    MsgBox "WMI情報取得中にエラーが発生しました: " & Err.Description, vbCritical
    GetNetworkAdapterInformation = Empty
    Resume Exit_Function
End Function

Private Function GetWMIProperty(ByVal objWMI As Object, ByVal strPropertyName As String) As Variant
    On Error Resume Next ' プロパティが存在しない場合もエラーにならないようにする
    GetWMIProperty = objWMI.Properties_(strPropertyName).Value
    If Err.Number <> 0 Then
        GetWMIProperty = Empty ' プロパティが存在しないか、値がない場合はEmptyを返す
        Err.Clear
    End If
    On Error GoTo 0
End Function

Private Function GetConnectionStatusDescription(ByVal status As Long) As String
    Select Case status
        Case 0: GetConnectionStatusDescription = "切断"
        Case 1: GetConnectionStatusDescription = "接続済み"
        Case 2: GetConnectionStatusDescription = "無効"
        Case 3: GetConnectionStatusDescription = "ネットワークに接続されていない"
        Case 4: GetConnectionStatusDescription = "接続中"
        Case 5: GetConnectionStatusDescription = "認証失敗"
        Case 6: GetConnectionStatusDescription = "認証成功"
        Case 7: GetConnectionStatusDescription = "ハードウェアテスト中"
        Case 8: GetConnectionStatusDescription = "ハードウェアテスト失敗"
        Case 9: GetConnectionStatusDescription = "電源オフ"
        Case Else: GetConnectionStatusDescription = "不明 (" & status & ")"
    End Select
End Function

Excelでの実装 (例: Module1.bas)

' Win32 APIをDeclare PtrSafeで宣言し、処理時間の計測に利用 (共通モジュールから取得)
#If VBA7 Then
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
    Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If

Sub ExportNetworkInfoToExcel()
    Dim vNetworkData As Variant
    Dim ws As Worksheet
    Dim lStartTime As Long
    Dim lEndTime As Long

    Set ws = ThisWorkbook.Sheets("Sheet1") ' 出力先のシート名

    ' 性能チューニング: Excelの描画、計算、イベントを一時停止
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    On Error GoTo ErrorHandler

    lStartTime = GetTickCount ' 開始時間計測

    ' WMIからネットワークアダプタ情報を取得
    vNetworkData = GetNetworkAdapterInformation()

    If Not IsEmpty(vNetworkData) Then
        ' 既存データをクリア
        ws.Cells.ClearContents

        ' ヘッダーとデータをシートに一括書き込み
        With ws.Range("A1").Resize(UBound(vNetworkData, 1), UBound(vNetworkData, 2))
            .Value = vNetworkData
            .EntireColumn.AutoFit
            .Rows(1).Font.Bold = True ' ヘッダー行を太字にする
        End With
    Else
        ws.Range("A1").Value = "ネットワークアダプタ情報が取得できませんでした。"
    End If

    lEndTime = GetTickCount ' 終了時間計測

    ' 性能チューニング: Excelの設定を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "Excelへの情報出力が完了しました。" & vbCrLf & _
           "処理時間: " & (lEndTime - lStartTime) / 1000 & " 秒", vbInformation

Exit_Sub:
    Exit Sub

ErrorHandler:
    MsgBox "Excelへの出力中にエラーが発生しました: " & Err.Description, vbCritical
    ' エラー時もExcel設定を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Resume Exit_Sub
End Sub

Accessでの実装 (例: Module1.bas)

' Win32 APIをDeclare PtrSafeで宣言し、処理時間の計測に利用 (共通モジュールから取得)
#If VBA7 Then
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
    Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If

Sub ExportNetworkInfoToAccess()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim vNetworkData As Variant
    Dim i As Long, j As Long
    Dim lStartTime As Long
    Dim lEndTime As Long
    Dim strTableName As String
    strTableName = "NetworkAdapters" ' 出力先のテーブル名

    Set db = CurrentDb

    ' 性能チューニング: Accessの警告メッセージを抑制
    DoCmd.SetWarnings False

    On Error GoTo ErrorHandler

    lStartTime = GetTickCount ' 開始時間計測

    ' WMIからネットワークアダプタ情報を取得
    vNetworkData = GetNetworkAdapterInformation()

    If Not IsEmpty(vNetworkData) Then
        ' テーブルが存在しない場合は作成
        On Error Resume Next
        Set tdf = db.TableDefs(strTableName)
        On Error GoTo ErrorHandler

        If tdf Is Nothing Then
            Set tdf = db.CreateTableDef(strTableName)
            ' ヘッダー行からフィールドを定義 (vNetworkData(1, *)がヘッダー)
            For j = 1 To UBound(vNetworkData, 2)
                Set fld = tdf.CreateField(Replace(vNetworkData(1, j), " ", ""), dbText, 255) ' スペース除去
                tdf.Fields.Append fld
            Next j
            db.TableDefs.Append tdf
            Set tdf = Nothing
        End If

        ' 既存データをクリア
        db.Execute "DELETE FROM " & strTableName, dbFailOnError

        ' 性能チューニング: トランザクション処理でレコード追加を高速化
        DBEngine.Workspaces(0).BeginTrans

        Set rs = db.OpenRecordset(strTableName, dbOpenTable)
        For i = 2 To UBound(vNetworkData, 1) ' ヘッダー行をスキップ
            rs.AddNew
            For j = 1 To UBound(vNetworkData, 2)
                rs.Fields(Replace(vNetworkData(1, j), " ", "")).Value = vNetworkData(i, j)
            Next j
            rs.Update
        Next i
        DBEngine.Workspaces(0).CommitTrans ' トランザクションをコミット
        rs.Close
    Else
        MsgBox "ネットワークアダプタ情報が取得できませんでした。", vbExclamation
    End If

    lEndTime = GetTickCount ' 終了時間計測

    ' 性能チューニング: Accessの警告メッセージを元に戻す
    DoCmd.SetWarnings True

    MsgBox "Accessテーブルへの情報出力が完了しました。" & vbCrLf & _
           "処理時間: " & (lEndTime - lStartTime) / 1000 & " 秒", vbInformation

Exit_Sub:
    Set rs = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Exit Sub

ErrorHandler:
    ' エラー時はトランザクションをロールバック
    If DBEngine.Workspaces(0).Transactions = True Then
        DBEngine.Workspaces(0).Rollback
    End If
    MsgBox "Accessへの出力中にエラーが発生しました: " & Err.Description, vbCritical
    ' エラー時もAccess設定を元に戻す
    DoCmd.SetWarnings True
    Resume Exit_Sub
End Sub

実行手順

  1. VBAエディタを開く: Excel/Accessファイルを開き、Alt + F11 でVBAエディタを開きます。
  2. モジュールを挿入: 「挿入」→「標準モジュール」を選択し、新しいモジュールを2つ作成します。
  3. コードのコピー:
    • 1つ目のモジュール（例: modNetworkInfo）に「共通モジュール」のコードを貼り付けます。
    • 2つ目のモジュール（例: Module1）に、使用するアプリケーションに応じた「Excelでの実装」または「Accessでの実装」のコードを貼り付けます。
  4. シート/テーブルの準備:
    • Excel: Sheet1 という名前のシートが既存であることを確認します。存在しない場合は作成またはコード内のシート名を変更します。
    • Access: NetworkAdapters という名前のテーブルが自動的に作成されますが、事前に作成しておいても構いません（この場合、フィールド名はコード内で定義されているものと一致させる必要があります）。
  5. マクロの実行: VBAエディタで、貼り付けたSubプロシージャ（ExportNetworkInfoToExcel または ExportNetworkInfoToAccess）を選択し、F5キーを押して実行します。または、Excel/Accessの「開発」タブからマクロを実行します。

検証

  • 情報正確性: 取得されたIPアドレス、MACアドレス、アダプタ名が、ipconfig /all コマンドやシステム情報ツールで確認できる内容と一致することを確認します。
  • 異なるネットワーク環境: 有線/無線LAN、DHCP/固定IP、VPN接続など、様々なネットワークアダプタ環境でテストし、正しく情報が取得されることを確認します。
  • エラーハンドリング: WMIサービスが停止している、または権限がない場合など、意図的にエラーを発生させて適切に処理されるかを確認します。

運用

本スクリプトで取得したネットワークアダプタ情報は、以下のような運用に役立ちます。

  • PC資産管理: 定期的に情報を収集し、ExcelやAccessデータベースで一元管理します。IPアドレスの重複チェックやMACアドレスによるデバイス特定に利用できます。
  • セキュリティ監査: 未知のネットワークアダプタの検出、DHCP設定の不正変更チェック、不正なIPアドレス使用状況の監視などに応用できます。
  • トラブルシューティング支援: ネットワーク接続問題発生時に、迅速にアダプタ情報を確認し、問題箇所の特定に役立てます。

落とし穴と対策

  1. WMI権限不足: スクリプトを実行するユーザーアカウントがWMIにアクセスする権限を持っていない場合、エラーが発生します。
    • 対策: 管理者権限でExcel/Accessを実行するか、WMIコントロールで該当ネームスペース (root\cimv2) へのアクセス権限を付与します。
  2. WMIサービス停止: WindowsのWMIサービスが何らかの理由で停止している場合、情報取得に失敗します。
    • 対策: サービスマネージャー (services.msc) で “Windows Management Instrumentation” サービスが実行中であることを確認します。
  3. オブジェクト参照の解放忘れ: WMIオブジェクト (objWMIService など) を適切に Set obj = Nothing で解放しないと、メモリリークやリソースの枯渇につながる可能性があります。
    • 対策: GoTo ErrorHandler の前に Set obj = Nothing をまとめて記述するか、Exit Function または Exit Sub の直前で解放処理を行うようにします。
  4. VBAの32/64ビット問題: Declare ステートメントでWin32 APIを使用する場合、VBA7 (Office 2010以降) では PtrSafe キーワードが必要です。また、ポインタサイズの違いから型を LongPtr にするなど考慮が必要です。
    • 対策: 本稿では PtrSafe を使用し、#If VBA7 Then で分岐させることで対応しています。WMI自体はCOMオブジェクトなのでこの問題の影響を受けにくいですが、API宣言時は注意が必要です。
  5. ネットワークアダプタの多重化/仮想化: 仮想マシンやVPN接続など、複数の仮想アダプタが存在する場合、取得される情報が膨大になることがあります。
    • 対策: WHERE句で条件を絞り込む (WHERE IPEnabled = TRUE など) か、DescriptionやNameプロパティで特定のアダプタのみを対象とするようにクエリを調整します。

まとめ

本稿では、VBAとCIM (WMI) を利用してネットワークアダプタ情報を取得し、Excel/Accessに効率よく出力する手法を解説しました。GetNetworkAdapterInformation 関数でWMIから情報を取得し、それを二次元配列に格納することで、アプリケーションへのデータ転送を最適化しています。

性能チューニングの効果: – Excel: 取得したデータを配列に格納後、Range.Value = vArray で一括書き込みすることで、ループ内でセルごとに書き込む場合に比べ、約100倍〜数千倍の高速化が見込めます（例: 1000行のデータで数秒→数十ミリ秒）。ScreenUpdating などを無効化することも体感速度に大きく寄与します。 – Access: DAO.Recordset の AddNew/Update を BeginTrans/CommitTrans で囲むことで、個々のレコード操作のオーバーヘッドを削減し、数倍〜数十倍の高速化が期待できます。

これらの手法は、単にネットワークアダプタ情報に限らず、WMIから取得可能なシステム情報全般に応用できます。Office環境でのシステム管理業務の自動化と効率化に、ぜひ本ガイドをご活用ください。

ロールバック方法

  • Excel: スクリプト実行前にファイルを保存しておけば、上書きされたシートの内容は元に戻せます。もし既存のデータが重要であれば、実行前にシート全体を別のシートにコピーしておくか、ファイルをバックアップすることを推奨します。
  • Access: テーブルにデータが挿入・更新されるため、実行前にデータベースファイル（.accdb）全体をバックアップすることが最も安全なロールバック方法です。また、DELETE FROM が実行されるため、もし既存のデータが重要であれば、そのデータをエクスポートしておくか、バックアップしたデータベースから復元してください。テーブルが新規作成された場合は、手動でそのテーブルを削除すれば元に戻せます。
ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

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