Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Script to list Add/Remove Programs on workstation

Posted on 2009-05-04
3
Medium Priority
?
1,011 Views
Last Modified: 2012-05-06
Hello,

I'm looking for a script which list all programs in Add/Remove Programs list + Program versions and output result in .csv file.

Script must also include programs, which are installed WITHOUT MSI installer. Script should direct output file to network share. I'm planning to attach this script to users logon script in AD.

Help would be highly appreciated!
0
Comment
Question by:SMCWindows
2 Comments
 
LVL 14

Accepted Solution

by:
yehudaha earned 1000 total points
ID: 24294058
try this

change this files path

computer list
Set objlist = objfso.OpenTextFile("c:\list.txt", ForReading)


log\result lof file
Set objlog = objfso.CreateTextFile("c:\log.csv", ForWriting)
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
 
 
Const ForReading = 1
Const ForWriting = 2
  
Set objfso = CreateObject("Scripting.FileSystemObject")
Set objlist = objfso.OpenTextFile("c:\list.txt", ForReading)
Set objlog = objfso.CreateTextFile("c:\log.csv", ForWriting)
 
Do Until objlist.AtEndOfStream	 
	strcomputer = objlist.ReadLine
	If Reachable(strcomputer) Then
		If per(strcomputer) Then
			objlog.WriteLine strcomputer
			objlog.WriteLine "**********"
			Set objReg = GetObject("winmgmts://" & strComputer & _
			"/root/default:StdRegProv")
			objReg.EnumKey HKLM, strKey, arrSubkeys
			For Each strSubkey In arrSubkeys
				intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
				strEntry1a, strValue1)
				If intRet1 <> 0 Then
					objReg.GetStringValue HKLM, strKey & strSubkey, _
					strEntry1b, strValue1
				End If
				If strValue1 <> "" Then
						objlog.Write strValue1 & vbNewLine
				End If
			Next
		Else
			objlog.WriteLine "Error To Connect To WMI on " & strcomputer & vbnewline
		End If
	Else
		objlog.WriteLine strcomputer & " Isn't Reachable" & vbNewLine
	End If
Loop
 
Function Reachable(strComputer)
	 
	strCmd = "ping -n 1 " & strComputer
	 
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec(strCmd)
	strTemp = UCase(objExec.StdOut.ReadAll)
	 
	If InStr(strTemp, "REPLY FROM") Then
		Reachable = True 
	Else
		Reachable = False
	End If
End Function
 
Function per(computer)
	strcomputer = computer
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	If err.number <> 0 Then
		err.Clear
		per = False
		On Error goto 0
	Else
		per = True
		On Error goto 0
	End If
End Function

Open in new window

0
 
LVL 6

Assisted Solution

by:Mark Pavlak
Mark Pavlak earned 1000 total points
ID: 24308618
here is a HTA I worte to docuement servers.  save the code to either .html .htm or .hta  You should be able to extract the info you want if it is to be stand alone etc.

<html>
 
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>My HTML Application</title>
<script language="vbscript">
<!-- Insert code, subroutines, and functions here -->
'Globals
'=============================================================================================
Dim objExcel,objWorksheet
Dim strComputerName,strPath
Dim intLastRow,intInstalledSoftwareStart,intInstalledSoftwareStop,IntBackupSchedule,intRebootProcedures,intDependancies
'=============================================================================================
'Excel Constants
'=============================================================================================
Const xlLeft = -4131
Const xlBottom = -4107
Const xlContext = -5002
Const xlUnderlineStyleNone = -4142
Const xlAutomatic = -4105
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6 
Const xlNone = -4142
Const xlEdgeLeft = 7
Const xlContinuous = 1
Const xlThin = 2
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const xlGeneral = 1
Const Xltop = -4160
Const xlDescending = 2
Const xlYes = 1
Const xlTopToBottom = 1
Const xlUp = -4162
Const xlCenter = -4108
Const XlRight = -4152
Const xlHairline = 1
Const xlPageBreakManual = -4135
Const xlToRight = -4161
 
'=============================================================================================
'Initialize Globals
'=============================================================================================
Set objExcel = CreateObject ("Excel.Application")
strPath =  Left(document.location.pathname,InStrRev(document.location.pathname,"\"))
'=============================================================================================
Sub Main ()
'Get User input on server ie Name,Crticallity,Backup Schedule,Depenancies,Boot Procedures
'=============================================================================================
strComputerName = form1.txtComputerName.value
'=============================================================================================
InitializeExcel(strComputerName)
SectionOne (strComputerName)
CriticalityOfServer ()
PrimaryPurpose()
SystemConfiguration(strComputerName)
AdditionalSoftwareInstalled(strComputerName)
BackUpSchedule() 
RebootProcedures()
Dependancies ()
FormatSheet ()
End Sub
Sub InitializeExcel(strCPUName)
 With objExcel
 	.Visible = True
 	.Workbooks.add(strPath+"\ExcelTemplates\Server.xlt")
 	.Worksheets(1).name = strCPUName
 	.ActiveWindow.DisplayGridlines = False
 	.DisplayAlerts = False
 	strPath =  Left(document.location.pathname,InStrRev(document.location.pathname,"\"))
 End With
 Set objWorksheet = objExcel.Worksheets(1) 
With objWorksheet
.PageSetup.PrintArea = ""
  .ResetAllPageBreaks
 .PageSetup.Zoom = 100
End With
  End Sub
Sub FormatSheet()
Dim objRange
'Format Section One
'=============================================================================================
'Set Font Options in Cell B1
'=============================================================================================
Set objRange = objWorksheet.range("B1")
objRange.Font.Bold = True 
'=============================================================================================
'Format Section One
'=============================================================================================
	'Set Borders for Section One
	'=================================================================================
		Set objRange = objWorksheet.Range("A1:B4")
	With objRange
		.HorizontalAlignment = xlLeft
	    .VerticalAlignment = xlBottom
	    .WrapText = False
	    .Orientation = 0
	    .AddIndent = False
	    .IndentLevel = 0
	    .ShrinkToFit = False
	    .ReadingOrder = xlContext
	End With
	objRange.Borders(xlDiagonalDown).LineStyle = xlNone
	objRange.Borders(xlDiagonalUp).LineStyle = xlNone
	With objRange.Borders(xlEdgeLeft)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	With objRange.Borders(xlEdgeTop)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	With objRange.Borders(xlEdgeBottom)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	With objRange.Borders(xlEdgeRight)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	With objRange.Borders(xlInsideVertical)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	With objRange.Borders(xlInsideHorizontal)
	    .LineStyle = xlContinuous
	    .Weight = xlThin
	    .ColorIndex = xlAutomatic
	End With
	'=================================================================================
	'Set Font For Section One
	'=================================================================================
	 Set objRange = objWorksheet.range("A1:B4")
	 With objRange.Font
    .Name = "Tahoma"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
	End With
	'=================================================================================
'=============================================================================================
'=============================================================================================
'Format Criticiality
'=============================================================================================
	'Format Criticality Header
	'=================================================================================
	Set objRange = objWorksheet.Range("A7:b8")
	With objRange
	        .HorizontalAlignment = xlGeneral
	        .VerticalAlignment = xlBottom
	        .WrapText = False
	        .Orientation = 0
	        .AddIndent = False
	        .IndentLevel = 0
	        .ShrinkToFit = False
	        .ReadingOrder = xlContext
	        .MergeCells = True
	    End With
	Set objRange = objWorksheet.range("A6:B6")
	 objRange.Borders(xlDiagonalDown).LineStyle = xlNone
	 objRange.Borders(xlDiagonalUp).LineStyle = xlNone
	 With objRange.Borders(xlEdgeLeft)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeTop)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeBottom)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeRight)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 objRange.Borders(xlInsideVertical).LineStyle = xlNone
	'=================================================================================
	'Format Check Box Space
	'=================================================================================
	Set objRange = objWorksheet.range("A7:B8")
	 objRange.Borders(xlDiagonalDown).LineStyle = xlNone
	 objRange.Borders(xlDiagonalUp).LineStyle = xlNone
	 With objRange.Borders(xlEdgeLeft)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeTop)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeBottom)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	 With objRange.Borders(xlEdgeRight)
	     .LineStyle = xlContinuous
	     .Weight = xlThin
	     .ColorIndex = xlAutomatic
	 End With
	'=================================================================================
	'=================================================================================
	'Set Font For Criticality of Server
	'=================================================================================
	 Set objRange = objWorksheet.range("A6:B8")
	 With objRange.Font
    .Name = "Tahoma"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
	End With
	'=================================================================================
	'Set font for High,Medium,Low
	'=================================================================================
	Set objRange = objWorksheet.range("A7")
	objRange.Font.Bold = True
	'=================================================================================
'=============================================================================================
'Format Primary Purpose
'=============================================================================================
Set objRange = objWorksheet.Range("A9:B9")
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Bold = True 
    End With
    Set objRange = objExcel.Range("A10")
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     objWorksheet.cells(9,1).interior.ColorIndex = 16
 '=============================================================================================
 '=============================================================================================
'Format System Configuration
'=============================================================================================
Set objRange = objWorksheet.Range("A14:B14")
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
End With
With objRange.Font
     .Name = "Tahoma"
     .FontStyle = "Regular"
     .Size = 10
     .Strikethrough = False
     .Superscript = False
     .Subscript = False
     .OutlineFont = False
     .Shadow = False
     .Underline = xlUnderlineStyleNone
     .ColorIndex = xlAutomatic
     .bold = True
End With
     objWorksheet.cells(14,1).interior.ColorIndex = 16
'=============================================================================================
'Format Additional Software
'=============================================================================================
	'Format Header
	'=================================================================================
		Set objRange = objWorksheet.range("A" &intInstalledSoftwareStart-1 & ":B" &intInstalledSoftwareStart-1)
	With objRange
	        .HorizontalAlignment = xlGeneral
	        .VerticalAlignment = xlBottom
	        .WrapText = False
	        .Orientation = 0
	        .AddIndent = False
	        .IndentLevel = 0
	        .ShrinkToFit = False
	        .ReadingOrder = xlContext
	        .MergeCells = True
	    End With
	    With objRange.Font
	        .Name = "Tahoma"
	        .FontStyle = "Regular"
	        .Size = 10
	        .Strikethrough = False
	        .Superscript = False
	        .Subscript = False
	        .OutlineFont = False
	        .Shadow = False
	        .Underline = xlUnderlineStyleNone
	        .ColorIndex = xlAutomatic
	        .bold = True
	    End With
	objWorksheet.cells(intInstalledSoftwareStart -1,1).interior.ColorIndex = 16
	'=================================================================================
	'Format Titles
	'=================================================================================
	Set objRange = objWorksheet.range("A" &intInstalledSoftwareStart & ":B" &intInstalledSoftwareStart)
	With objRange
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    objRange.Font.Bold = True
    objRange.Font.Italic = True
	'=================================================================================
	'Format Verision Cells to right
	'=================================================================================
	Set objRange = objWorksheet.Range("B" & intInstalledSoftwareStart + 1 & ":B" & intInstalledSoftwareStop -1)
	With objRange
        .HorizontalAlignment = XlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
	'=================================================================================
	'Format Text and Make Grid for Installed Software
	'=================================================================================
	Set objRange = objWorksheet.Range("A" & intInstalledSoftwareStart + 1 & ":B" & intInstalledSoftwareStop -1 )
	objRange.Borders(xlDiagonalDown).LineStyle = xlNone
    objRange.Borders(xlDiagonalUp).LineStyle = xlNone
    With objRange.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        
    End With
	'=================================================================================
'Format Backup Schedule		
'=============================================================================================
Set objRange = objWorksheet.Range("A"& IntBackupSchedule & ":B" &IntBackupSchedule)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Bold = True 
    End With
    Set objRange = objWorksheet.Range("A"& IntBackupSchedule + 1 & ":B" &IntBackupSchedule + 1)
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     objWorksheet.cells(IntBackupSchedule,1).interior.ColorIndex = 16
'=============================================================================================
'Format Reboot Procedures		
'=============================================================================================
Set objRange = objWorksheet.Range("A"& intRebootProcedures & ":B" &intRebootProcedures)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Bold = True 
    End With
    Set objRange = objWorksheet.Range("A"& intRebootProcedures + 1 & ":B" &intRebootProcedures + 1)
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     objWorksheet.cells(intRebootProcedures,1).interior.ColorIndex = 16
'=============================================================================================
'Format Dependancies
'=============================================================================================
Set objRange = objWorksheet.Range("A"& intDependancies & ":B" &intDependancies)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Bold = True 
    End With
    Set objRange = objWorksheet.Range("A"& intDependancies + 1 & ":B" &intDependancies + 1)
    With objRange.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     objWorksheet.cells(intDependancies,1).interior.ColorIndex = 16
'=============================================================================================
'=============================================================================================
'Autofit WorkSheet
'=============================================================================================
Set objRange = objWorksheet.UsedRange
objRange.EntireRow.Autofit()
objRange.EntireColumn.Autofit()
'=============================================================================================
Set objRange = objWorksheet.range("C:C")
objRange.pageBreak = xlPageBreakManual 
 
 
End Sub
Sub SectionOne (strComputerAccount)
'On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
'=============================================================================================
'Initalize WMI
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_OperatingSystem")
'=============================================================================================
'Get Attribues from Win32_LogicalDisk
'=============================================================================================
For Each objPCAttribute In objPC
With objWorksheet
	.cells(1,1).value = "Server Name:"
	.cells(1,2).value = UCase(strComputerAccount)
	.cells(2,1).value = "Location:"
	.cells(2,2).value = objPCAttribute.Description 
	.cells(3,1).value = "Operating System"
	.cells(3,2).value = objPCAttribute.Caption 
	.cells(4,1).value = "Service Pack"
	.cells(4,2).value = Replace(objPCAttribute.CSDVersion,"Service Pack","")
End With
Next
End Sub
Sub CriticalityOfServer ()
Dim objRange
objWorksheet.cells(6,1).value = "Criticality of Server"
'Check Apporiate box
If form1.High.checked Then
objWorksheet.cells(7,1).value = "High"
End If 
If form1.Medium.checked Then
objWorksheet.cells(7,1).value = "Medium"
End If 
If form1.Low.checked Then
objWorksheet.cells(7,1).value = "Low"
End If 
End Sub
Sub PrimaryPurpose ()
objWorksheet.cells(9,1).value = "Primary Purpose"
Set objRange = objWorksheet.range("A10:B13")
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
objWorksheet.cells(10,1).value = form1.PrimaryPurpose.Value
End Sub
Sub SystemConfiguration (strComputerAccount)
'Variables	
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim strClockSpeed,strProcessorNum,strIP
'=============================================================================================
'Set Title
'=============================================================================================
objWorksheet.cells(14,1).value = "System Configuration"
'=============================================================================================
'Set Title Column for Type,Serial#,Server Model,Manufacturer,RAM
'=============================================================================================
objWorksheet.cells(15,1).value = "Type"
objWorksheet.cells(16,1).value = "Serial Number"
objWorksheet.cells(17,1).value = "Server Model"
objWorksheet.cells(18,1).value  = "Manufactuer"
objWorksheet.cells(19,1).value  = "RAM"
objWorksheet.cells(20,1).value  = "Number of Processors"
'=============================================================================================
'Initalize WMI for Type,Model,Manufactuer,RAM
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
	''Get Attribues from WIN32_Computersystem
	'=================================================================================
	For Each objPCAttribute In objPC
		If (objPCAttribute.Manufacturer = "VMware, Inc.") Then
				objWorksheet.cells(15,2).value = "Virtual"
			Else
				objWorksheet.cells(15,2).value = "Physical"
		End If
	objWorksheet.cells(17,2).value = objPCAttribute.model
	objWorksheet.cells(18,2).value = objPCAttribute.Manufacturer
	objWorksheet.cells(19,2).value = FormatNumber(objPCAttribute.TotalPhysicalMemory/1073741824,2)+"gigs"   
	strProcessorNum = objPCAttribute.NumberOfProcessors
	Next
	'=================================================================================
'=============================================================================================
'Initalize WMI For Serial Number
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_SystemEnclosure")
	'Get Attribues from WIN32_SystemEnclosure
	'=================================================================================
		For Each objPCAttribute In objPC
		objWorksheet.cells(16,2).value =  objPCAttribute.SerialNumber
	Next
	'=================================================================================
'=============================================================================================
'Initalize WMI for Clock Speed
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_Processor")
	'Get Attribues from Win32_Processor
	'=================================================================================
	For Each objPCAttribute In objPC
		strClockSpeed = FormatNumber(objPCAttribute.MaxClockSpeed*.001,2)+"ghz"
	Next
	objWorksheet.cells(20,2).value = strProcessorNum&" @ "&strClockSpeed
	'=================================================================================
'=============================================================================================
intLastRow = 21
'Initalize WMI For Network Information
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration")
'=============================================================================================
	'Get Attribues from Win32_NetworkAdapterConfiguration
	'=================================================================================
		For Each objPCAttribute In objPC
		 If isNull(objPCAttribute.IPAddress) Then
	    Else
	    	intPlace = 0
	        'intCount = intCount + 1
			objWorksheet.cells(intLastRow,1) = "MAC Address"
			objWorksheet.cells(intLastRow,2) = "IP Addresses "
			objWorksheet.cells(intLastRow+1,1) = objPCAttribute.MACAddress
			objWorksheet.cells(intLastRow+1,1) = objPCAttribute.MACAddress
	       ' wscript.echo "IP Addresses: "&Join(objPCAttribute.IPAddress, "  ")
	        intLastRow = intLastRow + 1
	       intArraySize = UBound (objPCAttribute.IPAddress)+ 1
	       Do While intArraySize <> 0
	       	objWorksheet.cells(intLastRow+intPlace,2) = objPCAttribute.IPAddress(intPlace)
	      	intPlace = intPlace + 1
	      	intArraySize = intArraySize - 1
	      	Loop
	       intLastRow = intLastRow + intPlace
	    End If
	 Next
	'=================================================================================
'=============================================================================================
'Initalize WMI for HD information
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_LogicalDisk")
	'Get HD information
	'=================================================================================
	objWorksheet.cells(intLastRow,1) = "Drive Letter"
	objWorksheet.cells(intLastRow,2) = "Drive Size"
	intLastRow = intLastRow + 1
	For Each objPCAttribute In objPC
		If objPCAttribute.Description = "Local Fixed Disk" Then
			intCount = intCount + 1
			objWorksheet.cells(intLastRow,1) = objPCAttribute.DeviceID
			objWorksheet.cells(intlastrow,2) = FormatNumber(objPCAttribute.Size/1073741824,2)+"gigs"
			intCount = intCount + 1
			x = x+1
			intCount = 0
			intLastRow = intLastRow + 1
		End If
		
	Next
	'=================================================================================
'=============================================================================================
End Sub
Sub AdditionalSoftwareInstalled (strComputerAccount)
'Variables
'=============================================================================================
Const HKEY_LOCAL_MACHINE = &H80000002
Dim objReg,objKey,objSlaveWorksheet,objRange2,objWorkbook
Dim arrSubKeys,arrTemp
Dim strKeyPath,strDisplayName,strDisplayVersion,strTmp,strTmp1,strSubKey
Dim i
'=============================================================================================
'Initalize Variables
'=============================================================================================
strDisplayName = "DisplayName"
strDisplayVersion = "DisplayVersion"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
                        strComputerAccount & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
i = 1
Set objSlaveWorksheet = objExcel.Worksheets(2)
 
'=============================================================================================                
'Write Add/Remove to Seperate WorkSheet
'=============================================================================================
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each  objKey In arrSubKeys
On Error Resume Next
	objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath+"\"+objKey,strDisplayName,strTmp 
	objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath+"\"+objKey,strDisplayVersion,strTmp1 
	objSlaveWorksheet.cells(i,1).value = strTmp+"*"+strTmp1
	i = i + 1
Next   
'=============================================================================================
'Sort Add/Remove Sheet
'=============================================================================================
Set objRange = objSlaveWorksheet.range("A:A")
Set objRange2 = objSlaveWorksheet.Range("A1")
objRange.Sort objRange2, xlDescending, , , , , , xlYes
Set objRange2 = objSlaveWorksheet.range("1:1")
objRange2.delete xlUp
'=============================================================================================
'Rewrite To Section from Sheet2
'=============================================================================================
objWorksheet.cells(intLastRow,1).value = "Additional Software Installed"
intLastRow = intLastRow + 1
intInstalledSoftwareStart = intLastRow
objWorksheet.cells(intLastRow,1).value = "Software"
objWorksheet.cells(intLastRow,2).value = "Verision"
intLastRow = intLastRow + 1
i = FindEndOfSheet(objSlaveWorksheet,1) - 1
Do Until i = 0
arrTemp = SplitVerision(objSlaveWorksheet.cells(i,1))
objWorksheet.cells(intLastRow,1).value = arrTemp(0)
objWorksheet.cells(intLastRow,2).value = arrTemp(1)
intLastRow = intLastRow + 1
i = i -1
Loop
intInstalledSoftwareStop = intLastRow
'=============================================================================================
Set objSlaveWorksheet = Nothing
Set objWorkbook = objExcel.Workbooks(1)
objWorkbook.Worksheets("Sheet2").delete
Set objWorkbook = Nothing 
End Sub
Sub BackUpSchedule
objWorksheet.cells(intLastRow,1).value = "Backup Schedule"
IntBackupSchedule = intLastRow
intLastRow = intLastRow + 1
Set objRange = objWorksheet.range("A" & intLastRow & ":B" & intLastRow + 4)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
objWorksheet.cells(intLastRow,1).value = form1.BackupSchedule.Value
intLastRow = intLastRow + 5
End Sub
Sub RebootProcedures ()
objWorksheet.cells(intLastRow,1).value = "Reboot Procedures"
intRebootProcedures = intLastRow
intLastRow = intLastRow + 1
Set objRange = objWorksheet.range("A" & intLastRow & ":B" & intLastRow + 4)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = Xltop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
objWorksheet.cells(intLastRow,1).value = form1.RebootProcedures.Value
intLastRow = intLastRow + 5
End Sub
Sub Dependancies()
objWorksheet.cells(intLastRow,1).value = "Dependancies"
intDependancies = intLastRow
intLastRow = intLastRow + 1
Set objRange = objWorksheet.range("A" & intLastRow & ":B" & intLastRow + 4)
With objRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = Xltop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
objWorksheet.cells(intLastRow,1).value = form1.Dependancies.Value
End Sub
Sub CloseFile()
 
End sub
Function SplitVerision(strTemp)
Dim arrTmp
arrTmp = Split (strTemp,"*")
SplitVerision = arrTmp
End Function
Function FindEndOfSheet (objTempSheet,strColumn)
Dim strEOS
strEOS = 1
Do Until Len(objTempSheet.cells(strEOS,strColumn).value) = 0
	strEOS = strEOS + 1
Loop
FindEndOfSheet = strEOS
End Function
</script>
<hta:application
	applicationname="MyHTA"	
	border="dialog"
	borderstyle="normal"
	caption="Server Documentation"
	contextmenu="no"
	icon="myicon.ico"
	maximizebutton="no"
	minimizebutton="yes"
	navigable="no"
	scroll="no"
	selection="no"
	showintaskbar="yes"
	singleinstance="yes"
	sysmenu="yes"
	version="1.0"
	windowstate="normal"
>
</head>
<body>
<!-- HTML goes here -->
<form action="" method="get" name="form1">
Server Name: <INPUT TYPE="text" NAME="txtComputerName" SIZE=20 MAXLENGTH=20 VALUE="">
<br>
<br>
Criticality of Server: 
<br>
<INPUT TYPE="checkbox" NAME="High"> High     
<INPUT TYPE="checkbox" NAME="Medium"> Medium     
<INPUT TYPE="checkbox" NAME="Low"> Low
<br>
<br>
Primary Purpose: 
<br>
 
<textarea name="PrimaryPurpose" cols="40" rows="5"></textarea><br>
Back Up Schedule:
<br>
<textarea name="BackUpSchedule" cols="40" rows="5"></textarea><br>
 
Reboot Procedures :<br>
<textarea name="RebootProcedures" cols="40" rows="5"></textarea><br>
 
Dependancies :<br>
<textarea name="Dependancies" cols="40" rows="5"></textarea><br>
 
<INPUT TYPE="Button" NAME="CreateDocument" VALUE="Create Server Documentation" onclick= "Main">
</body>
</html>

Open in new window

0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Suggested Courses

824 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question