【ＶＢＡ】【ＷＭＩ】TCP/IP ネットワーク インターフェイスのパフォーマンスを監視する

「【ＶＢＡ】【ＷＭＩ】TCP/IP ネットワーク インターフェイスのパフォーマンスを監視する」

を参考にｖｂｓのコードをＶＢＡ化

パケットキャプチャ的なことは、windowsの場合、一定のソフトをダウンロードする必要があるというイメージだったけど、もwmiを使うと、似たようなことができるんだ。

これは知らなかった。

Option Explicit

#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub TCPIPネットワークインターフェイスのパフォーマンスを監視する()

    ‘microsoft wmi scripting 1.2 参照設定させる。
    Dim colItems As SWbemObjectSet
    Dim objItem As SWbemObjectEx
    Dim oLocator As SWbemLocator
    Dim objWMIService As SWbemServices
             
    Set oLocator = New WbemScripting.SWbemLocator
    Set objWMIService = oLocator.ConnectServer
    Dim objRefresher As New WbemScripting.SWbemRefresher
    Set colItems = objRefresher.AddEnum _
                    (objWMIService, "Win32_PerfFormattedData_TCPIP_NetworkInterface").ObjectSet
    objRefresher.Refresh
    Dim i As Integer

    For i = 1 To 10
        For Each objItem In colItems
            Debug.Print "Bytes Received Per Second: " & _
            objItem.BytesReceivedPersec
            Debug.Print "Bytes Sent Per Second: " & objItem.BytesSentPersec
            Debug.Print "Bytes Total Per Second: " & objItem.BytesTotalPersec
            Debug.Print "Caption: " & objItem.Caption
            Debug.Print "Current Bandwidth: " & objItem.CurrentBandwidth
            Debug.Print "Description: " & objItem.Description
            Debug.Print "Name: " & objItem.Name
            Debug.Print "Output Queue Length: " & objItem.OutputQueueLength
            Debug.Print "Packets Outbound Discarded: " & _
                objItem.PacketsOutboundDiscarded
            Debug.Print "Packets Outbound Errors: " & _
                objItem.PacketsOutboundErrors
            Debug.Print "Packets Per Second: " & objItem.PacketsPersec
            Debug.Print "Packets Received Discarded: " & _
                objItem.PacketsReceivedDiscarded
            Debug.Print "Packets Received Errors: " & _
                objItem.PacketsReceivedErrors
            Debug.Print "Packets Received Non-Unicast Per Second: " & _
                objItem.PacketsReceivedNonUnicastPersec
            Debug.Print "Packets Received Per Second: " & _
                objItem.PacketsReceivedPersec
            Debug.Print "Packets Received Unicast Per Second: " & _
                objItem.PacketsReceivedUnicastPersec
            Debug.Print "Packets Received Unknown: " & _
                objItem.PacketsReceivedUnknown
            Debug.Print "Packets Sent Non-Unicast Per Second: " & _
                objItem.PacketsSentNonUnicastPersec
            Debug.Print "Packets Sent Per Second: " & objItem.PacketsSentPersec
            Debug.Print "Packets Sent Unicast Per Second: " & _
                objItem.PacketsSentUnicastPersec
            objRefresher.Refresh
            Sleep 2000
            DoEvents
        Next
    Next

End Sub