Solved

Script to list Add/Remove Programs on workstation

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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

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…
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 …
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

758 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now