Solved

Script to list Add/Remove Programs on workstation

Posted on 2009-05-04
3
1,008 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 14

Accepted Solution

by:
yehudaha earned 250 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 250 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

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

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

In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
Introduction During my participation as a VBScript contributor at Experts Exchange, one of the most common questions I come across is this: "I have a script that runs against only one computer. How can I make it run against a list of computers in …
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…

630 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