Search code examples
vbanetwork-programmingwmi-querywql

VBA get Network usage from Network Interface


I have a problem with get Ethernet usage from Task Manager. I have CPU and RAM memory usage and now I can't get Ethernet usage. I'll be very happy if anyone help me, thanks.

My code so far:

    Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Function Logi()
    Dim date_now As Date: date_now = Now
    Dim user As String: user = Environ("username")

    Dim dict As String: dict = "dict"
    Dim file As String: file = "file"

    Dim file_size As Long: file_size = GetFileSize
    Dim core_count As Integer
    Dim cpu As String: cpu = CPUusage(core_count)
    Dim ram As String: ram = MemoryUsage

    Dim header As String
    Dim log As String

    header = "Date log|User|Description|File size|CPU usage|"
    For i = 1 To core_count - 1
        header = header & "Core " & i & "|"
    Next i
    header = header & "Percent of memory in use|Bytes of physical memory|Free physical memory|Paging file (bytes)|Free paging file (bytes)|User bytes of address space|Free user bytes|"

    log = date_now & "|" & user & "|" & desc & "|" & cpu & "|" & ram

    If Not fileExists(dict, file) Then
        Set obj_fso = CreateObject("Scripting.FileSystemObject")
        Set oTxtFile = obj_fso.CreateTextFile("dict & " \ " & file")
        oTxtFile.WriteLine header
        oTxtFile.WriteLine log
        oTxtFile.Close
    Else
        Open dict & "\" & file For Append As #1
        Write #1, log
        Close #1
    End If
End Function

Function fileExists(s_directory As String, s_fileName) As Boolean
    Dim obj_fso As Object
    Set obj_fso = CreateObject("Scripting.FileSystemObject")
    fileExists = obj_fso.fileExists(s_directory & "\" & s_fileName)
End Function

Function GetFileSize()
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.Getfile(ActiveWorkbook.FullName)
    GetFileSize = f.Size
End Function

Function GetCores()
    Dim objWMIService, cores, Proc, strQuery
    strQuery = "select * from Win32_PerfFormattedData_PerfOS_Processor"
    Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
    Set cores = objWMIService.ExecQuery(strQuery, , 48)
    Set GetCores = cores
End Function

Function CPUusage(ByRef core_count)
    Set cores = GetCores
    Dim ind As Integer: ind = 0
    For Each core In cores
    'CPU, Core 1, Core 2, Core 3, ...
        Select Case ind
            Case 0:
                cpu = core.PercentProcessorTime / 100 & "|"
            Case Else:
                cpu = cpu & core.PercentProcessorTime / 100 & "|"
        End Select
        ind = ind + 1
    Next
    core_count = ind
    CPUusage = Left(cpu, Len(cpu) - 1)
End Function

Function MemoryUsage()
    Dim MS As MEMORYSTATUS
    MS.dwLength = Len(MS)
    GlobalMemoryStatus MS

    'divide the memory variables by 1024 (nkb)
    'to obtain the size in kilobytes
    Dim mem As String: mem = ""
    mem = Format(MS.dwMemoryLoad, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwTotalPhys / 1024, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwAvailPhys / 1024, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwTotalPageFile / 1024, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwAvailPageFile / 1024, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwTotalVirtual / 1024, "###,###,###,###") & "|"
    mem = mem & Format(MS.dwAvailVirtual / 1024, "###,###,###,###")

    MemoryUsage = mem
End Function

Solution

  • For network details use this query : "SELECT * FROM Win32_NetworkAdapter WHERE NetEnabled=True"

    Remove the predicate if you want to get details about all the devices. Leave it on, if you want the details about active ones only.

    Note: You can format the speed with ROUND(SPEED/ 1024/1024/1024, 2)

    Example Code:

       Sub Test()
    
        Dim WMISrv          As Object
        Dim WMIObjSet       As Object
        Dim WMIObj          As Object
        Dim WMIProp         As Object
        Dim sWQL            As String
    
        '/ Use this query For Speed etc.
        sWQL = "SELECT * FROM Win32_NetworkAdapter  WHERE NetEnabled=True"
        '/ Use this query for Data packet information
        sWQL = "Select BytesReceivedPersec,BytesSentPersec,BytesTotalPersec  from  Win32_PerfRawData_Tcpip_NetworkInterface"
        Set WMISrv = GetObject("winmgmts:root/CIMV2")
        Set WMIObjSet = WMISrv.ExecQuery(sWQL)
    
        For Each WMIObj In WMIObjSet
            For Each WMIProp In WMIObj.Properties_
                If Not IsNull(WMIProp.Value) Then
                    If IsArray(WMIProp.Value) Then
                        For lCtr = LBound(WMIProp.Value) To UBound(WMIProp.Value)
                            Debug.Print WMIProp.Name & "(" & lCtr & ")" & ":" & WMIProp.Value(lCtr)
                        Next
                    Else
                         Debug.Print WMIProp.Name & ":" & WMIProp.Value
                    End If
                End If
            Next
        Next
    End Sub