VBA to Collect Computer Attritbutes

P

PosseJohn

New Member
Joined
May 3, 2018
Messages
1
Greetings All,

I have a school the runs 30+ computers. Recently, we had a lot of them stolen.

I would like to have my inventory not only list the SN of each, but also a lot of the fine details that help recover these items if it occurs again.

I am a start-up school, money is very tight, so paying for recovery software isn't quite possible yet.

Does anyone have a collection or guide on how to pull the computer information using VBA?

Here is my attributes I would like to see. Some of them are only to ensure they are setup equally.

Local Name
ComputerNetBIOS Name
DNS Name
Manufacturer
Model
Serial Number
Service Tag
Express Code
Operating SystemName
Build
Installation Date
Serial Number
WindowsVersion
Auto Update
Defender Status
Anti-VirusName
Status
Internet ExplorerVersion
PowerShellVersion
JavaVersion
Update
Build
BatterySerial Number
Power Profile Turn OffMonitorAC Power
Battery Power
Hard DiskAC Power
Battery Power
Power Profile SuspendAC Power
Battery Power
Optical ReaderMedia Type
Name
Serial Number
CPUName
Specification
RAMType
Size
MotherboardManufacturer
Model
Serial Number
BIOSBrand
Version
Date
Hard DriveManufacturer
Capacity
Serial Number
Power On Count
Power On Days
LAN AdapterMAC Address
IP Address
Subnet mask
Gateway server
DHCP
DNS Server
WiFi AdapterMAC Address
NetworkIP Address
Subnet mask
Gateway server
Preferred DNS server
Alternate DNS server

<colgroup><col><col><col></colgroup><tbody>
</tbody>


Thank you for your assistance.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
Hi I have something that I will post when I find it to get you started it will fill in quite a lot of your blanks but not all you may well have to do some research of your own
My routines started off as vbscript which I translated to vba, all of which came from google so I take no credit for the initial work
 
Upvote 0
okay here is some VBScript code first, followed by some VBA which is a subset of the VBscript
Code: 
'****
' This is a selection of various VB Scripts gleaned from Google etc, and modified to get our results
'
' Authors       unknown
' Modifications Jim Ward, 22nd Jan 2010
'
' what do we need
'
' 1) list of printer names
' 2) list of drive mappings along with drive letters
' 3) list of PST files on the C drive
' 4) list of PST files on the U drive
'
' Jim Ward, 23rd Jan 2010
' Added in IP address and Printer driver in the printer detail section
'
' Jim Ward, 28th Jan 2010
' Added in filesize in the PST search section for both C and U drives
' added in section to look for PAB, Personal Address Book files
'
' Jim Ward, 2nd Feb
' Added in monitor information
' Added in Mouse information
' Added in MAC address
' Added in IP address
' Added video info
' Added RAM
' Added last bootup time
' added hard drive info
'
'****
' lets get the computer name and username to use when creating output file
'****
'

strComputer = "."

Set objWMISvc = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
    strComputerName = objItem.Name
Next

Set WshNetwork = WScript.CreateObject("WScript.Network")
strCurrentUser = WshNetwork.UserName

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("C:\" & strcomputername & ".txt")

objTextFile.write("Computer Information" & vbcrlf & vbcrlf)

objTextFile.write("Current Machine Name :- " & strComputername & vbcrlf)
objTextFile.write("Current User Name    :- " & strCurrentUser & vbcrlf)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOS in colOperatingSystems
    dtmBootup = objOS.LastBootUpTime
    dtmLastBootupTime = WMIDateStringToDate(dtmBootup)
    objTextFile.write("Last Reboot: " & dtmLastBootupTime  & vbcrlf)
    dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now)   
    objTextFile.write("System is online for " & dtmSystemUptime & " hours" & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

objTextFile.write("Bios Information" & vbcrlf & vbcrlf)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colBIOS = objWMIService.ExecQuery _
    ("Select * from Win32_BIOS")
For each objBIOS in colBIOS
    objTextFile.write( "Build Number: " & objBIOS.BuildNumber & vbcrlf)
    objTextFile.write( "Current Language: " & objBIOS.CurrentLanguage & vbcrlf)
    objTextFile.write( "Installable Languages: " & objBIOS.InstallableLanguages & vbcrlf)
    objTextFile.write( "Manufacturer: " & objBIOS.Manufacturer & vbcrlf)
    objTextFile.write( "Name: " & objBIOS.Name & vbcrlf)
    objTextFile.write( "Primary BIOS: " & objBIOS.PrimaryBIOS & vbcrlf)
    objTextFile.write( "Release Date: " & objBIOS.ReleaseDate & vbcrlf)
    objTextFile.write( "Serial Number: " & objBIOS.SerialNumber & vbcrlf)
    objTextFile.write( "SMBIOS Version: " & objBIOS.SMBIOSBIOSVersion & vbcrlf)
    objTextFile.write( "SMBIOS Major Version: " & objBIOS.SMBIOSMajorVersion & vbcrlf)
    objTextFile.write( "SMBIOS Minor Version: " & objBIOS.SMBIOSMinorVersion & vbcrlf)
    objTextFile.write( "SMBIOS Present: " & objBIOS.SMBIOSPresent & vbcrlf)
    objTextFile.write( "Status: " & objBIOS.Status & vbcrlf)
    objTextFile.write( "Version: " & objBIOS.Version & vbcrlf)
    For i = 0 to Ubound(objBIOS.BiosCharacteristics)
        objTextFile.write( "BIOS Characteristics: " & _
            objBIOS.BiosCharacteristics(i) & vbcrlf)
    Next
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)


objTextFile.write("More Computer Information" & vbcrlf & vbcrlf)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colSettings 
    objTextFile.write( "OS Name: " & objOperatingSystem.Name & vbcrlf)
    objTextFile.write( "Version: " & objOperatingSystem.Version & vbcrlf)
    objTextFile.write( "Service Pack: " & _
        objOperatingSystem.ServicePackMajorVersion _
            & "." & objOperatingSystem.ServicePackMinorVersion & vbcrlf)
    objTextFile.write( "OS Manufacturer: " & objOperatingSystem.Manufacturer & vbcrlf)
    objTextFile.write( "Windows Directory: " & _
        objOperatingSystem.WindowsDirectory & vbcrlf)
    objTextFile.write( "Locale: " & objOperatingSystem.Locale & vbcrlf)
    objTextFile.write( "Available Physical Memory: " & _
        objOperatingSystem.FreePhysicalMemory & vbcrlf)
    objTextFile.write( "Total Virtual Memory: " & _
        objOperatingSystem.TotalVirtualMemorySize & vbcrlf)
    objTextFile.write( "Available Virtual Memory: " & _
        objOperatingSystem.FreeVirtualMemory & vbcrlf)
    objTextFile.write( "OS Name: " & objOperatingSystem.SizeStoredInPagingFiles & vbcrlf)
Next
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings 
    objTextFile.write( "System Name: " & objComputer.Name & vbcrlf)
    objTextFile.write( "System Manufacturer: " & objComputer.Manufacturer & vbcrlf)
    objTextFile.write( "System Model: " & objComputer.Model & vbcrlf)
    objTextFile.write( "Time Zone: " & objComputer.CurrentTimeZone & vbcrlf)
    objTextFile.write( "Total Physical Memory: " & _
        objComputer.TotalPhysicalMemory & vbcrlf)
Next
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_Processor")
For Each objProcessor in colSettings 
    objTextFile.write( "System Type: " & objProcessor.Architecture & vbcrlf)
    objTextFile.write( "Processor: " & objProcessor.Description & vbcrlf)
Next
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_BIOS")
For Each objBIOS in colSettings 
    objTextFile.write( "BIOS Version: " & objBIOS.Version & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

objTextFile.write("Memory Information" & vbcrlf & vbcrlf)

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
For Each objItem in colItems
    objTextFile.write("Bank Label: " & objItem.BankLabel & vbcrlf)
    objTextFile.write("Capacity: " & objItem.Capacity & vbcrlf)
    objTextFile.write("Data Width: " & objItem.DataWidth & vbcrlf)
    objTextFile.write("Description: " & objItem.Description & vbcrlf)
    objTextFile.write("Device Locator: " & objItem.DeviceLocator & vbcrlf)
    objTextFile.write("Form Factor: " & objItem.FormFactor & vbcrlf)
    objTextFile.write("Hot Swappable: " & objItem.HotSwappable & vbcrlf)
    objTextFile.write("Manufacturer: " & objItem.Manufacturer & vbcrlf)
    objTextFile.write("Memory Type: " & objItem.MemoryType & vbcrlf)
    objTextFile.write("Name: " & objItem.Name & vbcrlf)
    objTextFile.write("Part Number: " & objItem.PartNumber & vbcrlf)
    objTextFile.write("Position In Row: " & objItem.PositionInRow & vbcrlf)
    objTextFile.write("Speed: " & objItem.Speed & vbcrlf)
    objTextFile.write("Tag: " & objItem.Tag & vbcrlf)
    objTextFile.write("Type Detail: " & objItem.TypeDetail & vbcrlf)
    objtextfile.write("-----------------------------------------" & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

objTextFile.write("Processor Information" & vbcrlf & vbcrlf)
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
For Each objItem in colItems
    objtextfile.write( "Address Width: " & objItem.AddressWidth & vbcrlf)
    objtextfile.write( "Architecture: " & objItem.Architecture & vbcrlf)
    objtextfile.write( "Availability: " & objItem.Availability & vbcrlf)
    objtextfile.write( "CPU Status: " & objItem.CpuStatus & vbcrlf)
    objtextfile.write( "Current Clock Speed: " & objItem.CurrentClockSpeed & vbcrlf)
    objtextfile.write( "Data Width: " & objItem.DataWidth & vbcrlf)
    objtextfile.write( "Description: " & objItem.Description & vbcrlf)
    objtextfile.write( "Device ID: " & objItem.DeviceID & vbcrlf)
    objtextfile.write( "Ext Clock: " & objItem.ExtClock & vbcrlf)
    objtextfile.write( "Family: " & objItem.Family & vbcrlf)
    objtextfile.write( "L2 Cache Size: " & objItem.L2CacheSize & vbcrlf)
    objtextfile.write( "L2 Cache Speed: " & objItem.L2CacheSpeed & vbcrlf)
    objtextfile.write( "Level: " & objItem.Level & vbcrlf)
    objtextfile.write( "Load Percentage: " & objItem.LoadPercentage & vbcrlf)
    objtextfile.write( "Manufacturer: " & objItem.Manufacturer & vbcrlf)
    objtextfile.write( "Maximum Clock Speed: " & objItem.MaxClockSpeed & vbcrlf)
    objtextfile.write( "Name: " & objItem.Name & vbcrlf)
    objtextfile.write( "PNP Device ID: " & objItem.PNPDeviceID & vbcrlf)
    objtextfile.write( "Processor Id: " & objItem.ProcessorId & vbcrlf)
    objtextfile.write( "Processor Type: " & objItem.ProcessorType & vbcrlf)
    objtextfile.write( "Revision: " & objItem.Revision & vbcrlf)
    objtextfile.write( "Role: " & objItem.Role & vbcrlf)
    objtextfile.write( "Socket Designation: " & objItem.SocketDesignation & vbcrlf)
    objtextfile.write( "Status Information: " & objItem.StatusInfo & vbcrlf)
    objtextfile.write( "Stepping: " & objItem.Stepping & vbcrlf)
    objtextfile.write( "Unique Id: " & objItem.UniqueId & vbcrlf)
    objtextfile.write( "Upgrade Method: " & objItem.UpgradeMethod & vbcrlf)
    objtextfile.write( "Version: " & objItem.Version & vbcrlf)
    objtextfile.write( "Voltage Caps: " & objItem.VoltageCaps & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

objTextFile.write("Drive Information" & vbcrlf & vbcrlf)

strComputer = "."

Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")

For Each objItem in colItems
Select Case objItem.DriveType
Case 1 strDriveType = "Drive could not be determined."
Case 2 strDriveType = "Removable Drive"
Case 3 strDriveType = "Local hard disk."
Case 4 strDriveType = "Network disk." 
Case 5 strDriveType = "Compact disk (CD)" 
Case 6 strDriveType = "RAM disk." 
Case Else strDriveType = "Drive type Problem."
End Select

If objItem.DriveType =2 or objItem.DriveType =3 then

    strDiskSize = Int(objItem.Size /1048576) & " MB" 

    objTextFile.write("Drive Letter: " & objItem.Name & vbCrlf) 
    objTextFile.write("Description: " & objItem.Description & vbCrlf)
    objTextFile.write("Volume Name: " & objItem.VolumeName & vbCrlf)
    objTextFile.write("Media Type: " & objItem.MediaType & vbCrlf)
    objTextFile.write("VolumeSerialNumber: " & objItem.VolumeSerialNumber & vbCrlf)
    objTextFile.write("Drive Type : " & strDriveType & vbCrlf)
    objTextFile.write("File System : " & objitem.filesystem & vbCrlf)
    objTextFile.write("Disk Size : " & strDiskSize & vbCrlf)
    objTextFile.write("Free Space : " & Int(objItem.FreeSpace /1048576) & " MB" & vbCrlf)
    objtextfile.write("-----------------------------------------" & vbcrlf)
end if
Next



objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem in colItems
    objTextFile.write("Network Adapter Name: " & objItem.Caption & vbcrlf)
    For Each objAddress in objItem.IPAddress
        objTextFile.write("IP Address: " & objAddress & vbcrlf)
    Next
    objTextFile.write("Current MAC Address :- " & objItem.MACAddress & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' Monitor information
'****
'

objTextFile.write("Monitor(s) Information" & vbcrlf & vbcrlf)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0)
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor") 
For Each objItem in colItems
    objTextFile.write("Current Monitor Make   :- " & objitem.MonitorManufacturer & vbcrlf)
    objTextFile.write("Current Monitor Type   :- " & objItem.MonitorType & vbcrlf)
    objTextFile.write("Current Monitor Name   :- " & objItem.Name & vbcrlf) 
    objTextFile.write("Current Monitor Width  :- " & objItem.ScreenWidth & vbcrlf)
    objTextFile.write("Current Monitor Height :- " & objItem.ScreenHeight & vbcrlf)
    objTextFile.write("Display Type: " & objItem.DisplayType & vbcrlf)
    objTextFile.write("Pixels Per X Logical Inch: " & objItem.PixelsPerXLogicalInch & vbcrlf)
    objTextFile.write("Pixels Per Y Logical Inch: " & objItem.PixelsPerYLogicalInch & vbcrlf)
    objtextfile.write("-----------------------------------------" & vbcrlf)
Next 
objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' Video Adapter information
'****
'

objTextFile.write("Video Adapter(s) Information" & vbcrlf & vbcrlf)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("Select * from Win32_VideoController")

For Each objItem In colItems
    objTextFile.write("Adapter Compatibility: " & objItem.AdapterCompatibility & vbcrlf)
    objTextFile.write("Adapter DAC Type: " & objItem.AdapterDACType & vbcrlf)
    objTextFile.write("Adapter RAM: " & objItem.AdapterRAM & vbcrlf)
    objTextFile.write("Availability: " & objItem.Availability & vbcrlf)
    objTextFile.write("Color Table Entries: " & objItem.ColorTableEntries & vbcrlf)
    objTextFile.write("Current Bits Per Pixel: " & objItem.CurrentBitsPerPixel & vbcrlf)
    objTextFile.write("Current Horizontal Resolution: " & objItem.CurrentHorizontalResolution & vbcrlf)
    objTextFile.write("Current Number of Colors: " & objItem.CurrentNumberOfColors & vbcrlf)
    objTextFile.write("Current Number of Columns: " & objItem.CurrentNumberOfColumns & vbcrlf)
    objTextFile.write("Current Number of Rows: " & objItem.CurrentNumberOfRows & vbcrlf)
    objTextFile.write("Current Refresh Rate: " & objItem.CurrentRefreshRate & vbcrlf)
    objTextFile.write("Current Scan Mode: " & objItem.CurrentScanMode & vbcrlf)
    objTextFile.write("Current Vertical Resolution: " & objItem.CurrentVerticalResolution & vbcrlf)
    objTextFile.write("Description: " & objItem.Description & vbcrlf)
    objTextFile.write("Device ID: " & objItem.DeviceID & vbcrlf)
    objTextFile.write("Device Specific Pens: " & objItem.DeviceSpecificPens & vbcrlf)
    objTextFile.write("Dither Type: " & objItem.DitherType & vbcrlf)
    objTextFile.write("Driver Date: " & objItem.DriverDate & vbcrlf)
    objTextFile.write("Driver Version: " & objItem.DriverVersion & vbcrlf)
    objTextFile.write("ICM Intent: " & objItem.ICMIntent & vbcrlf)
    objTextFile.write("ICM Method: " & objItem.ICMMethod & vbcrlf)
    objTextFile.write("INF Filename: " & objItem.InfFilename & vbcrlf)
    objTextFile.write("INF Section: " & objItem.InfSection & vbcrlf)
    objTextFile.write("Installed Display Drivers: " & objItem.InstalledDisplayDrivers & vbcrlf)
    objTextFile.write("Maximum Memory Supported: " & objItem.MaxMemorySupported & vbcrlf)
    objTextFile.write("Maximum Number Controlled: " & objItem.MaxNumberControlled & vbcrlf)
    objTextFile.write("Maximum Refresh Rate: " & objItem.MaxRefreshRate & vbcrlf)
    objTextFile.write("Minimum Refresh Rate: " & objItem.MinRefreshRate & vbcrlf)
    objTextFile.write("Monochrome: " & objItem.Monochrome & vbcrlf)
    objTextFile.write("Name: " & objItem.Name & vbcrlf)
    objTextFile.write("Number of Color Planes: " & objItem.NumberOfColorPlanes & vbcrlf)
    objTextFile.write("Number of Video Pages: " & objItem.NumberOfVideoPages & vbcrlf)
    objTextFile.write("PNP Device ID: " & objItem.PNPDeviceID & vbcrlf)
    objTextFile.write("Reserved System Palette Entries: " & objItem.ReservedSystemPaletteEntries & vbcrlf)
    objTextFile.write("Specification Version: " & objItem.SpecificationVersion & vbcrlf)
    objTextFile.write("System Palette Entries: " & objItem.SystemPaletteEntries & vbcrlf)
    objTextFile.write("Video Architecture: " & objItem.VideoArchitecture & vbcrlf)
    objTextFile.write("Video Memory Type: " & objItem.VideoMemoryType & vbcrlf)
    objTextFile.write("Video Mode: " & objItem.VideoMode & vbcrlf)
    objTextFile.write("Video Mode Description: " & objItem.VideoModeDescription & vbcrlf)
    objTextFile.write("Video Processor: " & objItem.VideoProcessor & vbcrlf)
    objtextfile.write("-----------------------------------------" & vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' Mouse information
'****
'
objTextFile.write("Pointing Device Information" & vbcrlf & vbcrlf)


Set colMice = objWMIService.ExecQuery("Select * from Win32_PointingDevice")

For Each objMouse in colMice
    objTextFile.write("Hardware Type: " & objMouse.HardwareType & vbcrlf)
    objTextFile.write("Number of Buttons: " & objMouse.NumberOfButtons & vbcrlf)   
    objTextFile.write("Status: " & objMouse.Status & vbcrlf)
    objTextFile.write("PNP Device ID: " & objMouse.PNPDeviceID & vbcrlf)
    objtextfile.write("-----------------------------------------" & vbcrlf)
Next
objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' when run on a target machine we just use dot for the name
'****
'

strComputer = "."

'
'****
' lets query WMI for the printers
'****
'
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")

objTextFile.write("Printer Names === Network/Local === Port Name === Driver Name" & vbcrlf & vbcrlf)

For Each objPrinter in colPrinters
    If objPrinter.Attributes And 64 Then 
        strPrinterType = "Local"
    Else
        strPrinterType = "Network"
    End If

    objTextFile.write(objPrinter.Name & " === " & strPrinterType & " === On Port :- " & objprinter.portname & " === Driver :- " & _
                      objprinter.drivername & " === Location :- " & objprinter.location)
    objTextFile.write(vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' next the drive mappings, where type = 4 is network drive
'****
'

objTextFile.write("Drive Mappings" & vbcrlf & vbcrlf)

Set colDrives = objWMIService.ExecQuery _
    ("Select * From Win32_LogicalDisk Where DriveType = 4")

For Each objDrive in colDrives
    objTextFile.write ("Drive letter: " & objDrive.DeviceID & "===")
    objTextFile.write ("Network path: " & objDrive.ProviderName)
    objTextFile.write(vbcrlf)
Next

objTextFile.write(vbcrlf)
objtextfile.write("======================================" & vbcrlf)

'
'****
' now the search for PST files, we will find all PST files on the C Drive these may or may not belong
' to the current user, list them anyway
'****
'
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile Where Extension = 'pst' AND Drive = 'C:'")

objtextfile.write("PST files on the C drive" & vbcrlf & vbcrlf)
objtextfile.write("*** NOTE ****" & vbcrlf)
objtextfile.write("This list contains ALL PST files found on the C Drive some of which may not belong to the user " & vbcrlf)
objtextfile.write("the reason for this is two-fold, some users may have created a PST on the root of the C drive" & vbcrlf)
objtextfile.write("or it may belong in an old profile and been missed on any previous rebuild" & vbcrlf)
objtextfile.write("OR they may have created a PST and not connected to it via OUTLOOK" & vbcrlf)
objtextfile.write("Please ignore any in the list which you do not require" & vbcrlf)
objTextFile.Write(vbCrLf)

For Each objFile in colFiles
    objTextFile.Write(objFile.Drive & objFile.Path)
    objTextFile.Write(objFile.FileName & "." & objFile.Extension)
    objTextFile.Write(vbCrLf)

    objTextFile.write("Creation date: " & left(objfile.creationdate,8) & " @ " & mid(objfile.creationdate,9,2) & ":" & mid(objfile.creationdate,11,2) & vbcrlf)

    objTextFile.write("Last accessed: " & left(objfile.lastaccessed,8) & " @ " & mid(objfile.lastaccessed,9,2) & ":" & mid(objfile.lastaccessed,11,2) & vbcrlf)

    objTextFile.write("Last modified: " & left(objfile.lastmodified,8) & " @ " & mid(objfile.lastmodified,9,2) & ":" & mid(objfile.lastmodified,11,2) & vbcrlf)

    objTextFile.write("File Size    : " & objFile.FileSize & vbcrlf)
    objTextFile.write("-------------------------------------------------"& vbcrlf)
    objTextFile.Write(vbCrLf)
Next

objTextFile.Write(vbCrLf)
objTextFile.Write(vbCrLf)

'
'****
' now the search for PST files, we will find all PST files on the U Drive these may or may not be connected to OUTLOOK
'****
'

Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile Where Extension = 'pst' AND Drive = 'U:'")

objtextfile.write("PST files on the U drive" & vbcrlf & vbcrlf)
objtextfile.write("*** NOTE ****" & vbcrlf)
objtextfile.write("This list contains ALL PST files found on the U Drive that belong to the user " & vbcrlf)
objtextfile.write("they may have created a PST and not connected to it via OUTLOOK" & vbcrlf)
objtextfile.write("Please ignore any in the list which you do not require" & vbcrlf)
objTextFile.Write(vbCrLf)

For Each objFile in colFiles
    objTextFile.Write(objFile.Drive & objFile.Path)
    objTextFile.Write(objFile.FileName & "." & objFile.Extension)
    objTextFile.Write(vbCrLf)

    objTextFile.write("Creation date: " & left(objfile.creationdate,8) & " @ " & mid(objfile.creationdate,9,2) & ":" & mid(objfile.creationdate,11,2) & vbcrlf)

    objTextFile.write("Last accessed: " & left(objfile.lastaccessed,8) & " @ " & mid(objfile.lastaccessed,9,2) & ":" & mid(objfile.lastaccessed,11,2) & vbcrlf)

    objTextFile.write("Last modified: " & left(objfile.lastmodified,8) & " @ " & mid(objfile.lastmodified,9,2) & ":" & mid(objfile.lastmodified,11,2) & vbcrlf)

    objTextFile.write("File Size    : " & objFile.FileSize & vbcrlf)
    objTextFile.write("-------------------------------------------------"& vbcrlf)
    objTextFile.Write(vbCrLf)
Next

'
'****
' And finally PAB files
'****
'

Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile Where Extension = 'pab' AND Drive = 'C:'")

objtextfile.write("PAB files on the C drive" & vbcrlf & vbcrlf)
objtextfile.write("*** NOTE ****" & vbcrlf)
objtextfile.write("This list contains ALL PAB files found on the C Drive some of which may not belong to the user " & vbcrlf)
objtextfile.write("the reason for this is two-fold, some users may have created a PAB on the root of the C drive" & vbcrlf)
objtextfile.write("or it may belong in an old profile and been missed on any previous rebuild" & vbcrlf)
objtextfile.write("OR they may have created a PAB and not connected to it via OUTLOOK" & vbcrlf)
objtextfile.write("Please ignore any in the list which you do not require" & vbcrlf)
objTextFile.Write(vbCrLf)

For Each objFile in colFiles
    objTextFile.Write(objFile.Drive & objFile.Path)
    objTextFile.Write(objFile.FileName & "." & objFile.Extension)
    objTextFile.Write(vbCrLf)

    objTextFile.write("Creation date: " & left(objfile.creationdate,8) & " @ " & mid(objfile.creationdate,9,2) & ":" & mid(objfile.creationdate,11,2) & vbcrlf)

    objTextFile.write("Last accessed: " & left(objfile.lastaccessed,8) & " @ " & mid(objfile.lastaccessed,9,2) & ":" & mid(objfile.lastaccessed,11,2) & vbcrlf)

    objTextFile.write("Last modified: " & left(objfile.lastmodified,8) & " @ " & mid(objfile.lastmodified,9,2) & ":" & mid(objfile.lastmodified,11,2) & vbcrlf)

    objTextFile.write("File Size    : " & objFile.FileSize & vbcrlf)
    objTextFile.write("-------------------------------------------------"& vbcrlf)
    objTextFile.Write(vbCrLf)
Next

objTextFile.Write(vbCrLf)
objTextFile.Write(vbCrLf)

'
'****
' now the search for PAB files, we will find all PAB files on the U Drive these may or may not be connected to OUTLOOK
'****
'

Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile Where Extension = 'pab' AND Drive = 'U:'")

objtextfile.write("PST files on the U drive" & vbcrlf & vbcrlf)
objtextfile.write("*** NOTE ****" & vbcrlf)
objtextfile.write("This list contains ALL PAB files found on the U Drive that belong to the user " & vbcrlf)
objtextfile.write("they may have created a PAB and not connected to it via OUTLOOK" & vbcrlf)
objtextfile.write("Please ignore any in the list which you do not require" & vbcrlf)
objTextFile.Write(vbCrLf)

For Each objFile in colFiles
    objTextFile.Write(objFile.Drive & objFile.Path)
    objTextFile.Write(objFile.FileName & "." & objFile.Extension)
    objTextFile.Write(vbCrLf)

    objTextFile.write("Creation date: " & left(objfile.creationdate,8) & " @ " & mid(objfile.creationdate,9,2) & ":" & mid(objfile.creationdate,11,2) & vbcrlf)

    objTextFile.write("Last accessed: " & left(objfile.lastaccessed,8) & " @ " & mid(objfile.lastaccessed,9,2) & ":" & mid(objfile.lastaccessed,11,2) & vbcrlf)

    objTextFile.write("Last modified: " & left(objfile.lastmodified,8) & " @ " & mid(objfile.lastmodified,9,2) & ":" & mid(objfile.lastmodified,11,2) & vbcrlf)

    objTextFile.write("File Size    : " & objFile.FileSize & vbcrlf)
    objTextFile.write("-------------------------------------------------"& vbcrlf)
    objTextFile.Write(vbCrLf)
Next

'
'****
' All done, close the output file and post message box
'****
'
objTextFile.Close
wscript.echo "All Done, Look in " & "C:\" & strcomputername & ".txt"

Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate = CDate(Mid(dtmBootup, 7, 2) & "/" & _
         Mid(dtmBootup, 5, 2) & "/" & Left(dtmBootup, 4) _
         & " " & Mid (dtmBootup, 9, 2) & ":" & _
         Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, _
         13, 2))
End Function
 
Upvote 0
and now some vba
Code: 
Sub GetBiosInfo()
Dim WmObj As Object, test As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * from Win32_BIOS")
    
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "BIOSInfo"
Set objsheet = Worksheets("BIOSInfo")

Const NumHeader2 = 14
Dim Headers2(NumHeader2) As String
Headers2(1) = "Build Number"
Headers2(2) = "Current Language"
Headers2(3) = "Installable Languages"
Headers2(4) = "Manufacturer"
Headers2(5) = "Name"
Headers2(6) = "Primary BIOS"
Headers2(7) = "Release Date"
Headers2(8) = "Serial Number"
Headers2(9) = "SMBIOS Version"
Headers2(10) = "SMBIOS Major Version"
Headers2(11) = "SMBIOS Minor Version"
Headers2(12) = "SMBIOS Present"
Headers2(13) = "Status"
Headers2(14) = "Version"

For h = 1 To NumHeader2
    objsheet.Cells(1, h) = Headers2(h)
    objsheet.Cells(1, h).Font.Bold = True
Next

l = 2
For Each objItem In colitems
    objsheet.Cells(l, 1) = objItem.BuildNumber
    objsheet.Cells(l, 2) = objItem.CurrentLanguage
    objsheet.Cells(l, 3) = objItem.InstallableLanguages
    objsheet.Cells(l, 4) = objItem.Manufacturer
    objsheet.Cells(l, 5) = objItem.Name
    objsheet.Cells(l, 6) = objItem.PrimaryBIOS
    objsheet.Cells(l, 7) = objItem.ReleaseDate
    objsheet.Cells(l, 8) = objItem.SerialNumber
    objsheet.Cells(l, 9) = objItem.SMBIOSBIOSVersion
    objsheet.Cells(l, 10) = objItem.SMBIOSMajorVersion
    objsheet.Cells(l, 11) = objItem.SMBIOSMinorVersion
    objsheet.Cells(l, 12) = objItem.SMBIOSPresent
    objsheet.Cells(l, 13) = objItem.Status
    objsheet.Cells(l, 14) = objItem.Version

    l = l + 1
Next
    
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit

End Sub
Sub GetProcessorInfo()
Dim WmObj As Object, test As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * from Win32_Processor")
    
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ProcessorInfo"
Set objsheet = Worksheets("ProcessorInfo")

Const NumHeader2 = 2
Dim Headers2(NumHeader2) As String
Headers2(1) = "System Type"
Headers2(2) = "Processor"

For h = 1 To NumHeader2
    objsheet.Cells(1, h) = Headers2(h)
    objsheet.Cells(1, h).Font.Bold = True
Next

l = 2
For Each objItem In colitems
    objsheet.Cells(l, 1) = objItem.architecture
    objsheet.Cells(l, 1) = objItem.Description
    
    l = l + 1
Next
    
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit

End Sub
Sub GetMonitorInfo()
Dim WmObj As Object, test As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * from Win32_DesktopMonitor")
    
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MonitorInfo"
Set objsheet = Worksheets("MonitorInfo")

Const NumHeader2 = 8
Dim Headers2(NumHeader2) As String
Headers2(1) = "Current Monitor Make"
Headers2(2) = "Current Monitor Type"
Headers2(3) = "Current Monitor Name"
Headers2(4) = "Current Monitor Width"
Headers2(5) = "Current Monitor Height"
Headers2(6) = "Display Type"
Headers2(7) = "Pixels Per X Logical Inch"
Headers2(8) = "Pixels Per Y Logical Inch"

For h = 1 To NumHeader2
    objsheet.Cells(1, h) = Headers2(h)
    objsheet.Cells(1, h).Font.Bold = True
Next

l = 2
For Each objItem In colitems
    objsheet.Cells(l, 1) = objItem.MonitorManufacturer
    objsheet.Cells(l, 2) = objItem.MonitorType
    objsheet.Cells(l, 3) = objItem.Name
    objsheet.Cells(l, 4) = objItem.ScreenWidth
    objsheet.Cells(l, 5) = objItem.ScreenHeight
    objsheet.Cells(l, 6) = objItem.DisplayType
    objsheet.Cells(l, 7) = objItem.PixelsPerXLogicalInch
    objsheet.Cells(l, 8) = objItem.PixelsPerYLogicalInch
    l = l + 1
Next
    
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit

End Sub
Sub GetMemoryInfo()
Dim WmObj As Object, test As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")
  
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MemoryInfo"
Set objsheet = Worksheets("MemoryInfo")

Set colitems = WmObj.ExecQuery("Select * from Win32_PhysicalMemory", , 48)

Const NumHeader2 = 15
Dim Headers2(NumHeader2) As String
Headers2(1) = "Bank Label"
Headers2(2) = "Capacity"
Headers2(3) = "Data Width"
Headers2(4) = "Description"
Headers2(5) = "Device Locator"
Headers2(6) = "Form Factor"
Headers2(7) = "Hot Swappable"
Headers2(8) = "Manufacturer"
Headers2(9) = "Memory Type"
Headers2(10) = "Name"
Headers2(11) = "Part Number"
Headers2(12) = "Position In Row"
Headers2(13) = "Speed"
Headers2(14) = "Tag"
Headers2(15) = "Type Detail"

For h = 1 To NumHeader2
    objsheet.Cells(1, h) = Headers2(h)
    objsheet.Cells(1, h).Font.Bold = True
Next

l = 2
For Each objItem In colitems
    objsheet.Cells(l, 1) = objItem.BankLabel
    objsheet.Cells(l, 2) = objItem.Capacity
    objsheet.Cells(l, 3) = objItem.DataWidth
    objsheet.Cells(l, 4) = objItem.Description
    objsheet.Cells(l, 5) = objItem.DeviceLocator
    objsheet.Cells(l, 6) = objItem.FormFactor
    objsheet.Cells(l, 7) = objItem.HotSwappable
    objsheet.Cells(l, 8) = objItem.Manufacturer
    objsheet.Cells(l, 9) = objItem.MemoryType
    objsheet.Cells(l, 10) = objItem.Name
    objsheet.Cells(l, 11) = objItem.partnumber
    objsheet.Cells(l, 12) = objItem.PositionInRow
    objsheet.Cells(l, 13) = objItem.speed
    objsheet.Cells(l, 14) = objItem.Tag
    objsheet.Cells(l, 15) = objItem.TypeDetail
    
    l = l + 1
Next
    
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit

End Sub
Sub Win32_GetDefPrinterExample()
Dim WmObj As Object, test As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
For Each objprinter In colInstalledPrinters

   mstring = "Current Def Printer   :- " _
    & "Current Printer Name   :- " & objprinter.Name & vbCrLf _
    & "-----------------------------------------"
    MsgBox mstring
Next


End Sub
Sub GetIpMac()
Dim WmObj As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * from Win32_ComputerSystem", , 48)
For Each objItem In colitems
    strComputerName = objItem.Name
Next

Set colitems = WmObj.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem In colitems
    n = ("Network Adapter Name: " & objItem.Caption & vbCrLf)
    For Each objAddress In objItem.IPAddress
        i = ("IP Address: " & objAddress & vbCrLf)
    Next
    m = ("Current MAC Address :- " & objItem.MACAddress & vbCrLf)
Next
End Sub
Function GetIp() As String
Dim WmObj As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem In colitems
    GetIp = objItem.IPAddress
Next
End Function
Function GetMac() As String
Dim WmObj As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem In colitems
    GetMac = objItem.MACAddress
Next
End Function
Function GetMachineName() As String
Dim WmObj As Object

On Error Resume Next

Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")

Set colitems = WmObj.ExecQuery("Select * from Win32_ComputerSystem", , 48)
For Each objItem In colitems
    GetMachineName = objItem.Name
Next
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Search VBA did not show results
Replies
0
Views
426
Mantol
M
M
  • Question
consolidate duplicates with vbs
Replies
0
Views
1K
mipszzz
M
S
  • Question
OS information in excel using script and VBA
Replies
7
Views
7K
xenou
xenou
S
  • Question
VB Script to Excel cells using VBA
2 3
Replies
22
Views
8K
sanits591
S
savindrasingh
  • Question
Set IP to Static/Dynamic using VB Script
Replies
0
Views
10K
savindrasingh
savindrasingh

Forum statistics

Threads
1,214,972
Messages
6,122,530
Members
449,088
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top