Информация о материнской плате (MB), BIOS и дисках (HDD) - WMI

По материалам: https://www.cyberforum.ru/ms-access/thread2856670.html#post15608308

Private Sub HardWareInfo()
'es - 24.11.2022 v001 - Информация о материнской плате (MB), BIOS и дисках (HDD) - WMI
'По материалам : https://www.cyberforum.ru/ms-access/thread2856670.html#post15608308
'---------------------------------------------------------------------------------------------------
Dim strComputer$, sResult$, iVal%
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Object
Dim Model(10), InterfaceType(10), SerialNumber(10)
    
On Error GoTo HardWareInfo_Err
    
    strComputer = "."
    sResult = ""
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_BaseBoard")
    For Each objItem In colItems
        sResult = sResult & "SystemBoard: " & vbCrLf & vbTab & _
            "Manufacturer: " & objItem.Manufacturer & vbCrLf & vbTab & _
            "Model: " & objItem.Model & vbCrLf & vbTab & _
            "Product: " & objItem.Product & vbCrLf & vbTab & _
            "Serial Number: " & objItem.SerialNumber & vbCrLf
    Next
      
      
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS")
    For Each objItem In colItems
        sResult = sResult & "BIOS:" & vbCrLf & vbTab & _
            "Manufacturer: " & objItem.Manufacturer & vbCrLf & vbTab & _
            "Serial Number: " & objItem.SerialNumber & vbCrLf & vbTab & _
            "Version: " & objItem.Version & vbCrLf & vbTab & _
            "Name: " & objItem.Name & vbCrLf & vbTab & _
            "Release Date: " & objItem.ReleaseDate & vbCrLf & vbTab & _
            "SMBIOS Version: " & objItem.SMBIOSBIOSVersion & vbCrLf
    Next

      
'Enumerating Physical Disk Model
    iVal = 0
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
    For Each objItem In colItems
        Model(iVal) = objItem.Model
        InterfaceType(iVal) = objItem.InterfaceType
        iVal = iVal + 1
    Next
      
'Enumerating Physical Disk SerialNumber
    'Все устройства + DVD
    'Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMedia")
    'Только HDD:
    Set colItems = objWMIService.ExecQuery("SELECT DeviceID, SerialNumber FROM Win32_DiskDrive")
    
    iVal = 0
    For Each objItem In colItems
        SerialNumber(iVal) = objItem.SerialNumber
        sResult = sResult & "HDD " & iVal & ":" & vbCrLf & vbTab & _
        "Model: " & Model(iVal) & vbCrLf & vbTab & _
        "InterfaceType: " & InterfaceType(iVal) & vbCrLf & vbTab & _
        "SerialNumber: " & SerialNumber(iVal) & vbCrLf
        iVal = iVal + 1
    Next
  
    'MsgBox sResult
    Debug.Print sResult


HardWareInfo_End:
    On Error Resume Next
    Set objItem = Nothing
    Set colItems = Nothing
    Set objWMIService = Nothing
    Err.Clear
    Exit Sub

HardWareInfo_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub : " & _
           "HardWareInfo - mod00Test.", vbCritical, "Error!"
    'Debug.Print "HardWareInfo_Line: " & Erl & "."
    Err.Clear
    Resume HardWareInfo_End
End Sub