Trucos y tretas en Excel VBA para programadores - Obtener información de tu PC

Private oWMISrvEx As Object 'SWbemServicesEx
Private oWMIObjSet As Object 'SWbemServicesObjectSet
Private oWMIObjEx As Object 'SWbemObjectEx
Private oWMIProp As Object 'SWbemProperty
Private sWQL As String 'WQL Statement
Private n

Private AlreadyConnected As Boolean

Sub NetworkWMI()
    RetrieveInformation "Network"
End Sub

Sub LogicalDiskWMI()
    RetrieveInformation "LogicalDisk"
End Sub

Sub ProcessorWMI()
    RetrieveInformation "Processor"
End Sub

Sub PhysicalMemWMI()
    RetrieveInformation "PhysicalMemoryArray"
End Sub

Sub PrinterWMI()
    RetrieveInformation "Printer"
End Sub

Sub OnBoardWMI()
    RetrieveInformation "OnBoardDevice"
End Sub

Sub VideoControllerWMI()
    RetrieveInformation "VideoController"
End Sub

Sub OperatingWMI()
    RetrieveInformation "OperatingSystem"
End Sub

Sub SoftwareWMI()
    RetrieveInformation "Product"
End Sub

Sub ServicesWMI()
    RetrieveInformation "BaseService"
End Sub

'Notes:
'Win32_NetworkAdapterConfiguration – All of your network configuration settings
'Win32_LogicalDisk – Disks with capacities and free space.
'Win32_Processor – CPU Specs
'Win32_PhysicalMemoryArray – RAM/Installed Memory size
'Win32_VideoController – Graphics adapter and settings
'Win32_OnBoardDevice – Motherboard devices
'Win32_OperatingSystem – Which version of Windows with Serial Number
'WIn32_Printer – Installed Printers
'Win32_Product – Installed Software
'Win32_BaseService – List services running (or stopped) on any PC along with the service’s path and file name.

Private Sub RetrieveInformation(sSheet As String)
    Select Case sSheet
        Case "Network"
            sWQL = "Select * From Win32_NetworkAdapterConfiguration"
        Case "LogicalDisk"
            sWQL = "Select * From Win32_LogicalDisk"
        Case "Processor"
            sWQL = "Select * From Win32_Processor"
        Case "PhysicalMemoryArray"
            sWQL = "Select * From Win32_PhysicalMemoryArray"
        Case "VideoController"
            sWQL = "Select * From Win32_VideoController"
        Case "OnBoardDevice"
            sWQL = "Select * From Win32_OnBoardDevice"
        Case "OperatingSystem"
            sWQL = "Select * From Win32_OperatingSystem"
        Case "Printer"
            sWQL = "Select * From WIn32_Printer"
        Case "Product"
            sWQL = "Select * From Win32_Product"
        Case "BaseService"
            sWQL = "Select * From Win32_BaseService"
    End Select
    If Not SheetExists(sSheet) Then CreateSheet sSheet
    
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
    intRow = 2
    strRow = Str(intRow)
    
    ThisWorkbook.Sheets(sSheet).Range("A1").Value = "Name"
    ThisWorkbook.Sheets(sSheet).Cells(1, 1).Font.Bold = True
    
    ThisWorkbook.Sheets(sSheet).Range("B1").Value = "Value"
    ThisWorkbook.Sheets(sSheet).Cells(1, 2).Font.Bold = True
    
    For Each oWMIObjEx In oWMIObjSet
    
        For Each oWMIProp In oWMIObjEx.Properties_
            If Not IsNull(oWMIProp.Value) Then
                If IsArray(oWMIProp.Value) Then
                    For n = LBound(oWMIProp.Value) To UBound(oWMIProp.Value)
                        Debug.Print oWMIProp.name & "(" & n & ")", oWMIProp.Value(n)
                        ThisWorkbook.Sheets(sSheet).Range("A" & Trim(strRow)).Value = oWMIProp.name
                        ThisWorkbook.Sheets(sSheet).Range("B" & Trim(strRow)).Value = oWMIProp.Value(n)
                        ThisWorkbook.Sheets(sSheet).Range("B" & Trim(strRow)).HorizontalAlignment = xlLeft
                        intRow = intRow + 1
                        strRow = Str(intRow)
                    Next
                Else
                    ThisWorkbook.Sheets(sSheet).Range("A" & Trim(strRow)).Value = oWMIProp.name
                    ThisWorkbook.Sheets(sSheet).Range("B" & Trim(strRow)).Value = oWMIProp.Value
                    ThisWorkbook.Sheets(sSheet).Range("B" & Trim(strRow)).HorizontalAlignment = xlLeft
                    intRow = intRow + 1
                    strRow = Str(intRow)
                End If
            End If
        Next
    Next
    AutoFitColumns
    SelectHome
End Sub

Function IsNetworkConnected() As Boolean
    Dim TLR As Long
    
    IsNetworkConnected = False
    'If Not SheetExists("Network") Then
        CreateSheet "Network"
    'End If
    SetSheetVisible "Network", True
    GotoSheet "Network"
    NetworkWMI
    TLR = TrueLastRow
    lRow = FindRowLabel(TLR, 1, "IPAddress")
    If lRow > 0 Then
        IsNetworkConnected = Cells(lRow, 2) <> ""
        AlreadyConnected = IsNetworkConnected
    Else
        AlreadyConnected = False
        IsNetworkConnected = False
    End If
    SetSheetVisible "Network", False, True
End Function

Function GetIPaddress() As String
    Dim TLR As Long
    GetIPaddress = ""
    If Not AlreadyConnected Then AlreadyConnected = IsNetworkConnected
    If AlreadyConnected Then
        SetSheetVisible "Network", True
        GotoSheet "Network"
        TLR = TrueLastRow
        GetIPaddress = Cells(FindRowLabel(TLR, 1, "IPAddress"), 2)
        SetSheetVisible "Network", False, True
    End If
End Function