Inventory machine hardware, etc..

STU1979 · Sep 25, 2006

So... I've been using this thread (

http://www.tek-tips.com/threadminder.cfm?pid=329

)for a while now and it has been invaluable however I'm not much of a programmer, more of a sys admin but pieced parts of the code together and this is what I have done.

The problem is when I run this on a Windows 2003 server I get the following error message "Call function required". The scripts still runs but fails if a remote machine is listed. Can anyone see whats going on and where it's failing?

On Error Resume Next
'========================================================================================
' TITLE: Script Template
' Description: Used for creating any script that will be ran against multiple machines so
' that a countdown will display the number of machines remaining (can be used
' against single machines, but was mainly created for multiple machines),
' pings the machine to make sure it is online before proceeding, logs the
' machines that are offline.
'
' Requirements: pclist.txt for multiple machines (each machine listed on their own line)
'
'========================================================================================
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("WScript.Shell")
Const strScript = "Script Template" 'Title for the InputBox
Const PCL = "pclist.txt" 'List containing multiple machines to run script against
Const OFF = "offline.csv" 'Let me know if the machines are offline
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Force script to run in "CScript" mode
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If Instr(1, WScript.FullName, "CScript", vbTextCompare) = 0 Then
oShell.Run "cscript """ & WScript.ScriptFullName & """", 1, False
WScript.Quit
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'-----------------------------------------------------------------------------
' User input to determine if script is ran against single or multiple machines.
'------------------------------------------------------------------------------
strComputer = InputBox("Which machine do you wish to run this script against?" & vbcrlf _
& vbcrlf & "Leave blank to run against " & chr(34) & PCL & chr(34),strScript,"")
If strComputer = "" Then
'--------------------------------------------------------------------------------------
'Check the date that pclist.txt was created to verify if we still want to use it or not.
'Select NO if you want to update the "pclist.txt"
'---------------------------------------------------------------------------------------
If oFS.FileExists(PCL)Then
Set file = oFS.GetFile(PCL)
myDate = file.DateLastModified
myOpt = MsgBox(PCL & " was created on " & myDate & vbcrlf & vbcrlf & "Would you still like to use it?",4,PCL & " check")
If myOpt = 7 Then
MsgBox "Script will now close.",0,"EXIT"
wscript.quit
End If
'-------------------------------------------------------------------------
'Grab the pclist and get a total count we are running the script against.
'This will give us our countdown in the Command Window as the script runs.
'-------------------------------------------------------------------------
Set file = oFS.GetFile(PCL)
Set pc = file.OpenAsTextStream(1,TristateUseDefault)
Do While pc.AtEndOfStream <> True
strComputer = Trim(pc.ReadLine)
strCount = strCount + 1
Loop
Set pc = file.OpenAsTextStream(1,TristateUseDefault)
Do While pc.AtEndOfStream <> True
strComputer = Trim(pc.ReadLine)
strCount = strCount - 1
wscript.echo strCount & " " & strComputer
Call PingMe(strComputer,strCount)
Call info
Loop
Else
'-----------------------------------------------------------
'No pclist.txt found and no machine name entered in InputBox
'-----------------------------------------------------------
wscript.echo "No " & PCL & " found!" & vbcr & "Script will now close."
wscript.quit
End If
Else
strCount = ""
Call PingMe(strComputer,strCount)
End If
wscript.echo "Finished"
'Functions
'------------------------------------------------------------------------------
Function PingMe(strComputer,strCount)
'-----------------------------------------------------------------------
'Verify that the machine is online before running the rest of the script
'-----------------------------------------------------------------------
Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" + strComputer + "'")
For Each oPingResult In cPingResults
If oPingResult.StatusCode = 0 Then
wscript.echo "call function required"
Else
call LogEvent(strComputer,"Offline")
End If
Next
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++
Function LogEvent(pc,msg)
'--------------------------------
'Machine is OFFLINE, create a log
'--------------------------------
Set strLogFile = oFS.OpenTextFile(OFF,8,True)
strLogFile.WriteLine pc & "," & msg
strLogFile.Close
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++

Function info

On Error Resume Next

Set oShell = CreateObject("wscript.Shell")
Set env = oShell.environment("Process")
strComputer = env.Item("Computername")
Const HKEY_LOCAL_MACHINE = &H80000002
Const UnInstPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
".\root\default:StdRegProv")

report = strComputer & " Computer Inventory" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)

report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "OS Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each objItem in colItems
report = report & "Caption: " & objItem.Caption & vbCrLf
report = report & "Description: " & objItem.Description & vbCrLf
report = report & "EncryptionLevel: " & objItem.EncryptionLevel & vbCrLf
report = report & "InstallDate: " & objItem.InstallDate & vbCrLf
report = report & "Manufacturer: " & objItem.Manufacturer & vbCrLf
report = report & "MaxNumberOfProcesses: " & objItem.MaxNumberOfProcesses & vbCrLf
report = report & "Name: " & objItem.Name & vbCrLf
report = report & "Organization: " & objItem.Organization & vbCrLf
report = report & "OSProductSuite: " & objItem.OSProductSuite & vbCrLf
report = report & "RegisteredUser: " & objItem.RegisteredUser & vbCrLf
report = report & "SerialNumber: " & objItem.SerialNumber & vbCrLf
report = report & "ServicePackMajorVersion: " & objItem.ServicePackMajorVersion
report = report & "ServicePackMinorVersion: " & objItem.ServicePackMinorVersion & vbCrLf
report = report & "Version: " & objItem.Version & vbCrLf
report = report & "WindowsDirectory: " & objItem.WindowsDirectory & vbCrLf

Next

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colSMBIOS = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")
For Each objSMBIOS in colSMBIOS
report = report & "HP Serial: " & objSMBIOS.SerialNumber & vbCrLf

next

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=True")
For Each objItem in colItems

report = report & "Mac Address: " & objItem.MACAddress & vbCRLf

next

Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Memory and Processor Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each objComputer in colSettings
'report = report & objComputer.Name & vbcrlf
report = report & objComputer.TotalPhysicalMemory /1024\1024+1 & "MB Total memory" & vbcrlf
Next
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_Processor")
For Each objProcessor in colSettings
report = report & objProcessor.Description & " Processor" & vbCrLf
Next

report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Disk Drive Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf

Set objWMIService = GetObject("winmgmts:")
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
report = report & objLogicalDisk.FreeSpace /1024\1024+1 & "MB Free Disk Space" & vbCrLf
report = report & objLogicalDisk.Size /1024\1024+1 & "MB Total Disk Space" & vbCrLf

oReg.EnumKey HKEY_LOCAL_MACHINE, UnInstPath, arrSubKeys
software = software & vbCrLf & "******************************************" & vbCrLf
software = software & "Installed Software" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each subkey In arrSubKeys
'MsgBox subkey
If Left (subkey, 1) <> "{" Then
software = software & subkey & vbCrLf
End If
Next

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("D:\temp\" & strComputer & ".txt", ForWriting)
ts.write report
ts.write software

End Function

SjrH · Sep 25, 2006

Here is a script that i've recently used to inventory all the laptops and desktop systems in our domain....

The basic function of the script is to query AD for all systems that have contacted AD within the last 60 days, then build a list of 'live' and 'disconnected' systems.

From this list the script then builds an excel spreadsheet for each system detailing points such as - computer name, ip address, cpu details, hdd & ram details, network and video info, installed printers, installed applications, user profiles etc....

You will have to change certain specifics such as the password and domain name. The script requires an account that has admin privilidges to the host systems root drive (assumed to be administrator).

Code:

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2
Const ForAppending=8

Dim RowNumber, ColumnNumber, sComputer
Dim path, sAdminID, spassword
Dim oConnection,oCommand,oRecordSet,oComputer, oShell
Dim sDomain, iDuration
Dim dtmValue,iDateDiff

Set oShell=CreateObject("Wscript.Shell")
Set oFso=CreateObject("Scripting.FileSystemObject")

'Create log file for listing old NT 4.0 machines...
Set oFile=oFso.CreateTextFile(oShell.CurrentDirectory & "\NT4noWMI.txt",True)

'Create log file for machines detected as live in AD
If oFso.FileExists(oShell.CurrentDirectory & "\LiveInADMcs.txt") then
	Set oFile3=oFso.OpenTextFile(oShell.CurrentDirectory & "\LiveInADMcs.txt", ForAppending)
Else
	Set oFile3=oFso.CreateTextFile(oShell.CurrentDirectory & "\LiveInADMcs.txt",True)
End If

'Create log file for machines detected as live in AD, but are not contactable
If oFso.FileExists(oShell.CurrentDirectory & "\DisconnectedMcs.txt") then
	Set oFile4=oFso.OpenTextFile(oShell.CurrentDirectory & "\DisconnectedMcs.txt", ForAppending)
Else
	Set oFile4=oFso.CreateTextFile(oShell.CurrentDirectory & "\DisconnectedMcs.txt",True)
End If

RowNumber = 1 : ColumnNumber = 1

'Set username and Password
spassword = "YOUR PASSWORD" 'case sensitive

'----------------------------------'
'Get all workstations in the domain'
'----------------------------------'
i=1 : iCount=0

sDomain="DC=YOUR DOMAIN,DC=com"
iDuration=60

Set oConnection = CreateObject("ADODB.Connection")
Set oCommand =   CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "Active Directory Provider"

Set oCommand.ActiveConnection = oConnection
'Retrieve all computer object in specified domain
oCommand.CommandText = "Select Name,DistinguishedName from 'LDAP://OU=Desktops,OU=HPS_Computers," & sDomain & "' where objectClass='computer'"
oCommand.Properties("Page Size") = 1500
oCommand.Properties("Timeout") = 30
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
oCommand.Properties("Cache Results") = False

Set oRecordSet = oCommand.Execute

oRecordSet.MoveFirst

Do While not oRecordSet.EOF
	'Retrieve each computer object and get PasswordLastChanged property.
	Set oComputer = GetObject("LDAP://" & oRecordSet.Fields("DistinguishedName").Value)
	dtmValue = CDate(oComputer.PasswordLastChanged)

 	'Check time difference by day.
	iDateDiff=CInt(Now - dtmValue)

	If CInt(iDateDiff) < iDuration  Then

		'Close off WMI Object references to last computer in list
		Set owmiLocator=Nothing : Set oWMIService=Nothing

		sComputer=Replace(oComputer.Name,"CN=","")

		'This lists all machines in OU which has contacted AD within last 60 days
		oFile3.WriteLine sComputer

		If Not oFso.FileExists("D:\Scripts\SysInv\" & sComputer & ".xls") Then

			iCount=iCount+1
			sAdminID = sComputer & "\administrator"

			set oWMILocator = CreateObject("WbemScripting.SWbemLocator")
			set oWMIService = oWMILocator.ConnectServer(scomputer,,sAdminID,spassword)

			if err.number <> 0 then
				'this lists all machines which fail a connect - i.e. Probably would fail a ping too..
				oFile4.WriteLine sComputer
			Else

				Set XL = CreateObject("Excel.Application")
				XL.workbooks.add
				XL.Visible = False

				Call Summary
				Call Printers
				Call Applications
				Call Profiles
			
				XL.Application.DisplayAlerts = False 'enables ability to overwrite existing file when Activeworkbook.SAVEAS is used
				XL.Activeworkbook.SAVEAS "D:\SysInv\" & sComputer & ".xls"
				XL.Close
				XL.Quit
				Set XL=Nothing
			End if


		END IF
		
	End If

 	oRecordSet.MoveNext
	Err.Clear
Loop

Msgbox "Finished investigating workstations in the Domain..."

'clean up memory allocation
oFile.Close
set oWMIService = nothing : set oWMILocator = nothing : set colItems = nothing
oFile3.WriteLine iCount
oFile3.Close

Set oFso=Nothing

Sub Profiles

	On Error Resume Next

	Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
	Const ForReading=1
	
	'Reinistantiate WMI Connection - Only doing so because of error when leaving as global	
	Set oWMILocator=Nothing : Set oWMIService=Nothing
	set oWMILocator = CreateObject("WbemScripting.SWbemLocator")
	set oWMIService = oWMILocator.ConnectServer(sComputer,"Root\Default",sAdminID,spassword)

	Err.Clear
	Set oRegistry=oWMIService.Get("StdRegProv")
	If Err.Number<>0 Then 

		oShell.Run Chr(34) & oShell.CurrentDirectory & "\Kix32.exe" & Chr(34) & " " & Chr(34) & oShell.CurrentDirectory & "\Profile.kix" & Chr(34) & " $Computer=" & sComputer,,True
		If oFso.FileExists("C:\Log.Txt") Then

			RowNumber = 1
			ColumnNumber = 1

			Set ofile2=oFso.OpenTextFile("C:\Log.Txt",ForReading)
			McProfiles=oFile2.ReadAll
			oFile2.Close : Set oFile2=Nothing
			oFso.DeleteFile "C:\Log.Txt"
			
			XL.Sheets.Add.name = "Profiles"

			'Excel spreadsheet headings
			For Each sProfile In Split(McProfiles, vbCrLf)
				If sProfile <> "" Then
					If Instr(sProfile,"DEFAULT=") Then
						sValue=Replace(sProfile,"DEFAULT=","")
				 	Else
						XL.Cells(RowNumber, ColumnNumber).Value = sProfile : ColumnNumber = ColumnNumber + 1
				 		RowNumber = RowNumber + 1
				 		ColumnNumber = 1
					End If
				End If
			Next

			XL.Cells.EntireColumn.AutoFit
			set colItems = nothing
			RowNumber = 1

			ColumnNumber=2 : RowNumber=1
			XL.Cells(RowNumber, ColumnNumber).Value = sValue
			
		End If
	
	Else

		XL.Sheets.Add.name = "Profiles"

		RowNumber = 1
		ColumnNumber = 1

		strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
		oRegistry.EnumKey HKLM, strKeyPath, arrSubkeys
 
		For Each objSubkey In arrSubkeys

			sValueName = "ProfileImagePath"
			strSubPath = strKeyPath & "\" & objSubkey
			oRegistry.GetExpandedStringValue HKLM,strSubPath,sValueName,sValue

			XL.Cells(RowNumber, ColumnNumber).Value = sValue : ColumnNumber = ColumnNumber + 1
			RowNumber = RowNumber + 1
			ColumnNumber = 1
		Next

		oRegistry.GetStringValue HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon","DefaultUserName", sValue

		ColumnNumber=2 : RowNumber=1
		XL.Cells(RowNumber, ColumnNumber).Value = sValue

	End If
End Sub

Sub Printers

	XL.Sheets.Add.name = ucase(sComputer) & "Printers"

	RowNumber = 1
	ColumnNumber = 1

	XL.Cells(RowNumber, ColumnNumber).Value = "Description" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Printer" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Driver Name" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Port Name" : ColumnNumber = ColumnNumber + 1

	Set colItems = oWMIService.ExecQuery("SELECT * FROM Win32_Printer")

	RowNumber = RowNumber + 1
	ColumnNumber = 1

	For Each objItem In colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Description : ColumnNumber = ColumnNumber + 1 
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.DeviceID : ColumnNumber = ColumnNumber + 1 
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.DriverName : ColumnNumber = ColumnNumber + 1 
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.PortName : ColumnNumber = ColumnNumber + 1 
		RowNumber = RowNumber + 1 : ColumnNumber = 1
	Next

End Sub

Sub Summary

	Set colItems = oWMIService.ExecQuery("Select Name from Win32_ComputerSystem",,48)
	For each objItem in colItems
		sComputer = objItem.name 'Get Computer Name
	Next

	'Summary section
	RowNumber = 1
	ColumnNumber = 1

	XL.Sheets.Add.name = "Summary"
	'Excel spreadsheet headings
	XL.Cells(RowNumber, ColumnNumber).Value = "SerialNumber" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "AdapterDescription" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "DNSDomain" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "IPAddress" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Description/Asset #" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Caption" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "CSDVersion" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Manufacturer" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "ClockSpeed" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Name" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Name" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Vendor" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "NumberOfProcessors" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "TotalPhysicalMemory MB" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Disk Space GB" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "MediaType" : ColumnNumber = ColumnNumber + 1
	XL.Cells(RowNumber, ColumnNumber).Value = "Model" : ColumnNumber = ColumnNumber + 1

	RowNumber = RowNumber + 1
	ColumnNumber = 1

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select SerialNumber from Win32_BIOS",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.SerialNumber : RowNumber = RowNumber + 1
	Next
	set colItems = nothing
	ColumnNumber = ColumnNumber + 1
	RowNumber = 2

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select Description, DNSDomain, IPAddress from Win32_NetworkAdapterConfiguration",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Description : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.DNSDomain : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.IPAddress : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 2
	Next
	ColumnNumber = ColumnNumber + 3
	RowNumber = 2

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select Caption, Description, CSDVersion from Win32_OperatingSystem",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Description : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Caption : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.CSDVersion : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 2
	Next
	ColumnNumber = ColumnNumber + 3
	RowNumber = 2

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select Manufacturer, CurrentClockSpeed, Name from Win32_Processor",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Manufacturer : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.CurrentClockSpeed : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Name : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 2
	Next
	ColumnNumber = ColumnNumber + 3
	RowNumber = 2

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select Name, Vendor from Win32_ComputerSystemProduct",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Name : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Vendor : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 1
	Next
	ColumnNumber = ColumnNumber + 2
	RowNumber = 2

	set colItems = nothing
	Set colItems = oWMIService.ExecQuery("Select NumberOfProcessors, TotalPhysicalMemory from Win32_ComputerSystem",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.NumberOfProcessors : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.TotalPhysicalMemory / (1024*1024) : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 1
	Next
	ColumnNumber = ColumnNumber + 2
	RowNumber = 2

	Set colItems = oWMIService.ExecQuery("Select size, MediaType, Model from Win32_DiskDrive",,48)
	For Each objItem in colItems
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Size / (1024*1024*1024) : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.MediaType : ColumnNumber = ColumnNumber + 1
		XL.Cells(RowNumber, ColumnNumber).Value = objItem.Model : RowNumber = RowNumber + 1 : ColumnNumber = ColumnNumber - 2
	Next
	XL.Cells.EntireColumn.AutoFit
	ColumnNumber = 1
	RowNumber = 1
	set colItems = nothing

End sub

Sub Applications

	Dim sAppslist

	sAppsList = InstalledApplications

	RowNumber = 1
	ColumnNumber = 1

	XL.Sheets.Add.name = "Applications"

	'Excel spreadsheet headings
	For Each sAppName In Split(sAppsList, vbCrLf)
		If sAppName <> "" Then
			 XL.Cells(RowNumber, ColumnNumber).Value = sAppName : ColumnNumber = ColumnNumber + 1
			 RowNumber = RowNumber + 1
			 ColumnNumber = 1
		End If
	Next

	XL.Cells.EntireColumn.AutoFit
	set colItems = nothing
	RowNumber = 1
End sub


Function InstalledApplications

	On Error Resume Next

	Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
	Const ForReading=1
	
	'Reinistantiate WMI Connection - Only doing so because of error when leaving as global
	Set oWMILocator=Nothing : Set oWMIService=Nothing
	set oWMILocator = CreateObject("WbemScripting.SWbemLocator")
	set oWMIService = oWMILocator.ConnectServer(sComputer,"Root\Default",sAdminID,spassword)

	Err.Clear
	Set oRegistry=oWMIService.Get("StdRegProv")
	If Err.Number<>0 Then
		'NT 4.0 Machine with no WMI Core 1.5 - call KIX Script to get information...
		oFile.WriteLine scomputer
		oShell.Run Chr(34) & oShell.CurrentDirectory & "\Kix32.exe" & Chr(34) & " " & Chr(34) & oShell.CurrentDirectory & "\Applic.kix" & Chr(34) & " $Computer=" & scomputer,,True
		If oFso.FileExists("C:\Log.Txt") Then
			Set ofile2=oFso.OpenTextFile("C:\Log.Txt",ForReading)
			InstalledApplications=oFile2.ReadAll
			oFile2.Close : Set oFile2=Nothing
			oFso.DeleteFile "C:\Log.Txt"
		End If
	Else


		sValue=""
		InstalledApplications=""

		sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
		iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)
		For Each sKey In arSubKeys
			sValue=""
			oRegistry.GetStringValue HKLM,sBaseKey & sKey,"DisplayName",sValue 
			If sValue="" Then
				oRegistry.GetStringValue HKLM,sBaseKey & sKey,"QuietDisplayName",sValue
			End If
			If sValue<>"" Then
				InstalledApplications = InstalledApplications & sValue & vbCrLf
			End If
		Next

	End If

	Set oRegistry=Nothing

End Function

[small]Listen to those who know, believe in those that do[/small]

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Inventory machine hardware, etc..

STU1979

Technical User

SjrH

IS-IT--Management

Similar threads

Part and Inventory Search

Sponsor