Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Script to list Add/Remove Programs on workstation

Posted on 2009-05-04
3
Medium Priority
?
1,010 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 1000 total points
ID: 24294058
try this

change this files path

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


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

Open in new window

0
 
LVL 6

Assisted Solution

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

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

Open in new window

0

Featured Post

Independent Software Vendors: 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

Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
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 …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…

715 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