Private Sub List_of_Drives()   ' инфо о дисках компьютера
     Dim DRV: Const DriveType = 2    '0-"UnKnown", 1-"Removable", 2-"HDD", 3-"Network", 4-"CD/DVD", 5-"RAM"
     On Error Resume Next
     For Each DRV In CreateObject("Scripting.FileSystemObject").Drives
        If DRV.DriveType = DriveType Then
Debug.Print "------------------------"
Debug.Print "DriveLetter = " & DRV.DriveLetter
Debug.Print "IsReady = " & DRV.IsReady
Debug.Print "VolumeName = " & DRV.VolumeName
Debug.Print "TotalSize = " & DRV.TotalSize
Debug.Print "AvailableSpace = " & DRV.AvailableSpace
Debug.Print "SerialNumber = " & Hex$(DRV.SerialNumber)
        End If
     Next
End Sub

Private Sub DrvSerialNumber()   'серийный номер диска С на компьютере
Debug.Print Hex$(CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber)
End Sub

Private Sub test_SYSTEM_INFO()   ' получение системной информации
     On Error Resume Next
     Dim objWMIService
     Set objWMIService = GetObject("WinMgmts:{ImpersonationLevel=Impersonate}!\\" & "." & "\root\cimv2")

     ' операционная система
     Dim colOperatingSystems, objOperatingSystem
     Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
     For Each objOperatingSystem In colOperatingSystems
Debug.Print "OS RegisteredUser: " & objOperatingSystem.RegisteredUser
Debug.Print "OS SerialNumber: " & objOperatingSystem.SerialNumber
     Next

     ' процессор
     Dim colProcessor, objProcessor
     Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
     For Each objProcessor In colProcessor
Debug.Print "CPU ProcessorId: " & objProcessor.ProcessorId
     Next

     On Error GoTo 0
End Sub

Private Sub OS_Environment_Variable_Info()   ' информация о переменных среды ОС
     Dim i As Integer
     On Error Resume Next
     For i = 1 To 29
Debug.Print Environ(i)
     Next
End Sub

Private Sub OS_UserName()
     Dim objWMIService
     Set objWMIService = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
     Dim colOperatingSystems, objOperatingSystem
     Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
     For Each objOperatingSystem In colOperatingSystems
Debug.Print "OS RegisteredUser: " & objOperatingSystem.RegisteredUser
     Next
End Sub

Private Sub REG_UserName()
     Dim oReg, sKeyPath$, sValueName$, sValue$
     Set oReg = GetObject("WinMgmts:{ImpersonationLevel=Impersonate}!\\.\root\default:StdRegProv")
     sKeyPath = "Software\Microsoft\Windows\CurrentVersion\Explorer"
     sValueName = "Logon User Name"
     oReg.GetExpandedStringValue &H80000001, sKeyPath, sValueName, sValue
Debug.Print sValue
End Sub

Private Sub Net_UserName()
Debug.Print CreateObject("Wscript.Network").UserName
Debug.Print Application.UserName
End Sub