VBA 从网络接口获取网络使用情况

Question

我在从任务管理器获取以太网使用情况时遇到问题。我有 CPU 和 RAM 内存使用，现在我无法获得以太网使用。如果有人帮助我，我会很高兴，谢谢。

到目前为止我的代码：

    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

Answer 1

有关网络详细信息，请使用此查询： "SELECT * FROM Win32_NetworkAdapter WHERE NetEnabled=True"

如果您想获取有关所有设备的详细信息，请删除谓词。如果您只想要有关活动的详细信息，请保留它。

注意：您可以将速度格式化为ROUND(SPEED/ 1024/1024/1024, 2)

示例代码：

   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

VBA 从网络接口获取网络使用情况

VBA get Network usage from Network Interface

vba

networking

wmi-query

wql