Solved

Script to list Add/Remove Programs on workstation

Posted on 2009-05-04
3
1,004 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
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

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

Suggested Solutions

When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

679 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