エクセルでパソコン情報を取得するツールを作ってみました(WMI)|うぃむんののんびりギャザクラ日誌 #FF14

エクセルでパソコン情報を取得するツールを作ってみました(WMI)

こんばんは、うぃむです。

また、ちょっとエクセルのお勉強のお話です。

エクセルでパソコンのいろいろな情報を表示してみたいということはないでしょうか?

Windowsには、「Windows Management Instrumentation」(WMI)というのがあり、OSやコンピュータの構成などの情報が取得できるので、今回この取得ができるツールをエクセルで作ってみました。

なお、マクロは初心者なので、ソースコードは粗が多いとおもいますが、ご了承下さい。

WMIの取得ツールの使い方

説明

WMIは、Windows のシステム情報を取得できます。WMIの詳細は、以下をご確認ください。
https://learn.microsoft.com/ja-jp/windows/win32/wmisdk/wmi-start-page

操作方法

WMI一覧取得できたWMI等がリストから選択できます。
クエリWMI一覧で選択したものをクエリで表示します。
条件クエリの取得に条件等を追加したい場合は、記入します。
プロパティ[プロパティ取得]ボタンを押すと、選択したWMIのプロパティの一覧が表示されます。
プロパティ取得「プロパティ」にWMIのプロパティ一覧が表示されます。ただし、結果が取得できないものは表示されません。
WMIの結果取得「クエリ」「条件」を元に、結果を取得しシート「WMIの結果」に表示します。
初期化初期状態に戻します。

※WMIの内容は、みなさんで調べてください。

使用例1

WMIには「Win32_OperatingSystem」というのがあり、OSの情報が取得できます。WMI一覧で「Win32_OperatingSystem」を選択して、[WMIの結果取得]を押すと、以下の様に情報が取得できます。

使用例2

「Win32_PingStatus」は条件が空白だと取得できません。条件にPINGしたいIPアドレスを入れてあげると、結果が取得できます。例えば、FF14の日本DCのPING確認を行いたい場合であれば、条件に「Address = "124.150.157.15"」といれると結果がもどってくると思います。

マクロ(VBA)

ワークブックを開いたとき

WMIの一覧を取得し、非表示の「WMI一覧」に集めます。これを、シート「WMIの取得」のWMI一覧で選択が行なえるようにしています。

Private Sub Workbook_Open()

    ' 定義
    Dim oWMI            As SWbemServicesEx  ' WMIサービスオブジェクト
    
    Dim oQuerySet       As SWbemObjectSet   ' クエリ結果セット
    Dim oQueryEx        As SWbemObjectEx    ' クエリ結果
    
    Dim wsWMIList       As Worksheet
    Dim wsWMIGet        As Worksheet
    
    Dim sComputerName   As String
    Dim sQuery          As String
    
    Dim i               As Integer

    ' シートの取得
    Set wsWMIList = Worksheets("WMI一覧")
    Set wsWMIGet = Worksheets("WMIの取得")

    ' 対象のコンピューター
    sComputerName = "."
    
    ' 画面の更新を停止
    Application.ScreenUpdating = False

    ' WMIの定義
    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputerName & "\root\cimv2")
    
    ' WMI一覧の取得
    sQuery = "SELECT * FROM Meta_Class"
    Set oQuerySet = oWMI.ExecQuery(sQuery)
    
    ' [WMI一覧]の表示
    wsWMIList.Activate
    i = 1
    For Each oQueryEx In oQuerySet
        Cells(i, 1).Value = oQueryEx.SystemProperties_("__Class")
        i = i + 1
    Next

    wsWMIList.Sort.SortFields.Clear
    wsWMIList.Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsWMIList.Sort
        .SetRange Range("A:A")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' [WMIの取得]の表示
    wsWMIGet.Select
    
    With Worksheets("WMIの取得").Cells(1, 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=WMI一覧!$A:$A"
    End With

    ' 画面の更新を開始
    Application.ScreenUpdating = True

End Sub
クリア

初期状態に戻します。

Sub setClear()

    Application.ScreenUpdating = False
    
    Dim wsWMIGet        As Worksheet
    Dim wsWMIOut        As Worksheet
    
    Dim i               As Integer

    Set wsWMIGet = Worksheets("WMIの取得")
    Set wsWMIOut = Worksheets("WMIの結果")
    
    wsWMIOut.Select
    ' 現在の値を全て削除
    Cells.Select
    Selection.Delete Shift:=xlUp
    Cells(1, 1).Select
    
    wsWMIGet.Select
    
    For i = 5 To Cells(Rows.Count, 2).End(xlUp).Row
        Cells(i, 2) = ""
    Next
    
    Cells(1, 2).Select
    
    Application.ScreenUpdating = True

End Sub
プロパティ取得

「クエリ」「条件」を元に、プロパティを取得します。実際の取得は、上記の「WMIの情報取得」です。ここでは、処理前の確認をしています。

Sub getWMIProperties()

    ' プロパティのみ取得
    If vbCancel = MsgBox(Cells(1, 2).Value & " のプロパティを取得します。取得には時間がかかる場合があります。実行してよいでしょうか?", vbOKCancel + vbExclamation) Then
       Exit Sub
    End If
    
    getWMI (1)
    
End Sub
WMIの結果取得

「クエリ」「条件」を元に、WMIの結果を取得します。実際の取得は、上記の「WMIの情報取得」です。ここでは、処理前の確認をしています。

Sub getWMIAll()

    ' 結果の取得
    If vbCancel = MsgBox(Cells(1, 2).Value & " の情報を取得します。取得には時間がかかる場合があります。実行してよいでしょうか?", vbOKCancel + vbExclamation) Then
       Exit Sub
    End If
    
    getWMI (0)

End Sub
WMIの情報取得

「クエリ」「条件」を元に、結果を取得しています。パラメータが0の場合は「WMIの結果」に取得した情報を表示し、パラメーターが1の場合は「プロパティ」に一覧のみ表示します。

Sub getWMI(Optional iMode As Integer = 0)

    ' 画面の更新を停止
    Application.ScreenUpdating = False

    On Error Resume Next

    ' 定義
    Dim oLocator        As New SWbemLocator ' SWbemLocatorクラスオブジェクト
    Dim oWMI            As SWbemServicesEx  ' WMIサービスオブジェクト
    Dim oSet            As SWbemObjectSet   ' WMIの抽出結果
    Dim oEx             As SWbemObjectEx    ' WMIの内容
    
    Dim wsWMIGet        As Worksheet
    Dim wsWMIOut        As Worksheet
    
    Dim sComputerName   As String
    Dim sQuery          As String
    
    Dim o               As Object
    
    Dim i               As Integer
    Dim j               As Integer
    
    ' シートの取得
    Set wsWMIGet = Worksheets("WMIの取得")
    Set wsWMIOut = Worksheets("WMIの結果")

    ' WMIの取得画面へ
    wsWMIGet.Select
    
    
    ' シートを初期状態にする
    setClear
    
    sComputerName = "."

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputerName & "\root\cimv2")
    
    
    ' WMIの抽出クエリ
    sQuery = Cells(2, 2).Value
    If Cells(3, 2).Value <> "" Then
        sQuery = sQuery & " WHERE " & Cells(3, 2).Value
    End If
    
    
    ' WMIの結果
    If iMode = 1 Then
    Else
        wsWMIOut.Select
        ' 現在の値を全て削除
        Cells.Select
        Selection.Delete Shift:=xlUp
        Cells(1, 1).Select
    End If

    ' クエリの実行
    Set oSet = oWMI.ExecQuery(sQuery)
    
    ' プロパティの設定
    i = 1
    For Each o In oSet.ItemIndex(0).Properties_
        If iMode = 1 Then   'プロパティの取得のみ
            Cells(4 + i, 2).Value = o.Name
        Else        ' プロパティ+結果の取得
            Cells(1, i).Value = o.Name
        End If
        i = i + 1
    Next
    If Err.Number <> 0 Then
        MsgBox "プロパティが見つかりませんでした。"
        wsWMIGet.Select
        Application.ScreenUpdating = True

        Exit Sub
    End If
    If iMode = 1 Then
        Exit Sub
    End If
    
    ' 値の設定
    i = 2
    For Each oEx In oSet
        j = 1
        For Each o In oSet.ItemIndex(0).Properties_
            Cells(i, j).Value = oEx.Properties_(o.Name).Value
            j = j + 1
        Next
        
        i = i + 1
    Next

    Cells.EntireColumn.AutoFit

    ' 画面の更新を開始
    Application.ScreenUpdating = True

End Sub

作ったエクセル

WMIの取得.xlsm

(注意事項)

エクセルシートはマクロを使っています。ダウンロードしてエクセルで動かす必要があります。

ダウンロードしたファイルは、アクセスをブロックされると思います。その場合は、ファイルのプロパティから、「許可する」を選択してください。また、当シートはマクロも有効にして使ってください。

なお、このエクセルは勉強用で作成したものです。このファイルでのいかなる責任は負えませんのでご了承をお願いいたします。

最後に

WMIのプロパティのだけ取得したいというのは作れませんでした。ちゃんとした開発ツールであればできると思いますが、エクセルマクロではできなそうなので、断念しました。何か良い方法を知っていたら教えてくださいね。

本来のエクセルの用途とは違うかもしれません。とはいえ、それなりに動くツールとして作れました。簡単に作ろうと思っていたのですが、なんとなくこんなこともできるのかな?こんなこともできるのかな?とかやっていたら、こんな感じに出来上がってしまいました。マクロ初心者としては、まぁまぁでしょうかね?(笑)

0 件のコメント:

コメントを投稿

超解像技術(FSR 1.0/DLSS 2.0)と対応グラボ(GPU) #FF14

こんにちは、うぃむです。 先日(4/13)の「 第9回 14時間生放送 」の第80回 プロデューサーレターLIVEがありました。 この中で、黄金のレガシーでは「超解像技術」として、AMD FSR 1.0 / Nvidia DLSS 2.0 の対応が発表されました。 ...