Получить информацию о видеокарте - VB

'Используется WMI
'Option Explicit
Dim fso, wmio, nwo, strInform As String
Private Sub Command1_Click()
    strInform = ""
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set nwo = CreateObject("WScript.Network")
    If Len(LCase(nwo.ComputerName)) > 0 Then InformationAboutVideo (LCase(nwo.ComputerName))
    MsgBox strInform, vbInformation, "Видеоадаптер" 'Print strInform' переменная содержит информацию о видеоадаптере
End Sub
Sub InformationAboutVideo(CompName)
    Set wmio = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & CompName & "\Root\CIMV2")
        Log "Win32_VideoController", _
        "Name,AdapterRAM,VideoProcessor,VideoModeDescription,DriverDate,DriverVersion", "NOT (Name LIKE '%Secondary')", _
        " ", _
        "Наименование,Объем памяти (Мб),Видеопроцессор,Режим работы,Дата драйвера,Версия драйвера"
End Sub
 
'составить WQL-запрос, выполнить и записать в переменную
'входные параметры:
'from - класс WMI
'sel - свойства WMI, через запятую
'where - условие отбора или пустая строка
'sect - соответствующая секция отчета
'param - соответствующие параметры внутри секции отчета, через запятую
'для отображения в кратных единицах, нужно их указать в скобках
Sub Log(from, sel, where, sect, param)
    Dim i As Integer, query, clss, item, prop
    Const RETURN_IMMEDIATELY = 16, FORWARD_ONLY = 32
    query = "Select " & sel & " From " & from
    If Len(where) > 0 Then query = query & " Where " & where
    Set clss = wmio.ExecQuery(query, , RETURN_IMMEDIATELY + FORWARD_ONLY)
    Dim props, names, value
    props = Split(sel, ",")
    names = Split(param, ",")
    For Each item In clss
        For i = 0 To UBound(props)
            Set prop = item.Properties_(props(i))
            value = prop.value
            'без проверки на Null возможнен вылет с ошибкой
            If IsNull(value) Then
               value = ""
               ElseIf IsArray(value) Then
                      value = Join(value, ",")
               ElseIf Right(names(i), 4) = "(Мб)" Then
                      value = CStr(Round(value / 1024 ^ 2))
               ElseIf Right(names(i), 4) = "(Гб)" Then
                      value = CStr(Round(value / 1024 ^ 3))
               ElseIf prop.CIMType = 101 Then
                      value = ReadableDate(value)
             End If
             value = Trim(Replace(value, ";", "_"))
             If Len(value) > 0 Then
                    strInform = strInform & vbCrLf & names(i) & "  -        " & value
             End If
        Next
    Next
End Sub
Function ReadableDate(str)
    ReadableDate = Mid(str, 7, 2) & "." & Mid(str, 5, 2) & "." & Left(str, 4)
End Function