• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 874
  • Last Modified:

VBS Server Hardware / Software and SQL Audit

Hi,

I have a script that currently audits a pc and outputs the result into a text file on root c:

I would like this script to get some extra information including:-
SQL Instance Name
Processor Type
Processor Speed

And also for SQL Replication I would like the following information
Subscription Name
Publication Host
Publication Database
Subscription Host
Subscription Database
Type

Secondly, I would like the script to read the server names from an excel sheet and then output the results back into excel.

Kind of a big one I know but any help would be wonderful as this has to be done on hundreds of servers.

Regards
On Error Resume Next
 
Const HKEY_LOCAL_MACHINE = &H80000002
 
'change this value to the IP address or hostname of the machine you need to audit
strIPvalue = "."
 
CALL GenerateReport(strIPvalue)
 
WScript.Echo "Inventory Complete "
 
 
'=================================================================================
'SUB-ROUTINE GenerateReport
SUB GenerateReport(strIPvalue)
 
'Script to change a filename using timestamps
strPath = "C:\" 'Change the path to appropriate value
strMonth = DatePart("m", Now())
strDay = DatePart("d",Now())
 
if Len(strMonth)=1 then
strMonth = "0" & strMonth
else
strMonth = strMonth
end if
 
 
if Len(strDay)=1 then
strDay = "0" & strDay
else
strDay = strDay
end if
 
 
strFileName = DatePart("yyyy",Now()) & strMonth & strDay
strFileName = Replace(strFileName,":","")
'=================================================================================
 
'Variable Declarations
Const ForAppending = 8
 
'===============================================================================
'Main Body
On Error Resume Next
 
 
'CompName
strComputer = strIPvalue
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'===============================================================================
 
'================================================================
'For INTERNET EXPLORER
Dim strIE
Set objWMIService2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2\Applications\MicrosoftIE")
Set colIESettings = objWMIService2.ExecQuery("Select * from MicrosoftIE_Summary")
For Each strIESetting in colIESettings
strIE= " INTERNET EXPLORER: " & strIESetting.Name & " v" & strIESetting.Version & VBCRLF
Next
 
 
'Get Operation System & Processor Information
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor",,48)
For Each objItem in colItems
CompName = objItem.SystemName
Next
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
if objFSO.FileExists(strPath & CompName & "_" & strFileName & "_Audit.txt") then
WScript.Quit
end if
 
'Set the file location to collect the data
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strPath & CompName & "_" & strFileName & "_Audit.txt", ForAppending, True)
 
''==============================================================
'Print HEADER
objTextFile.Write "================================================================" & VBCRLF & VBCRLF
objTextFile.Write " SERVER RESOURCE AUDIT REPORT " & VBCRLF
objTextFile.Write " DATE: " & FormatDateTime(Now(),1) & " " & VBCRLF
objTextFile.Write " TIME: " & FormatDateTime(Now(),3) & " " & VBCRLF & VBCRLF
objTextFile.Write "================================================================" & VBCRLF & VBCRLF & VBCRLF & VBCRLF & VBCRLF
 
 
objTextFile.Write "COMPUTER" & VBCRLF
'==============================================================
'Get OPERATING SYSTEM & Processor Information
objTextFile.Write " COMPUTER NAME: " & CompName & VBCRLF
 
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor",,48)
For Each objItem in colItems
objTextFile.Write " PROCESSOR: " & objItem.Name & VBCRLF
Next
 
Set colProcs = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
 
For Each objItem in colProcs
objTextFile.Write " NUMBER OF PROCESSORS: " & objItem.NumberOfProcessors & VBCRLF & VBCRLF
Next
 
 
'================================================================
'Get DOMAIN NAME information
Set colItems = objWMIService.ExecQuery("Select * from Win32_NTDomain")
 
For Each objItem in colItems
objTextFile.Write " DOMAIN NAME: " & objItem.DomainName & VBCRLF
Next
 
'================================================================
'Get OS Information
Set colSettings = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objOperatingSystem in colSettings
objTextFile.Write " OPERATING SYSTEM: " & objOperatingSystem.Name & VBCRLF
objTextFile.Write " VERSION: " & objOperatingSystem.Version & VBCRLF
objTextFile.Write " SERVICE PACK: " & objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion & VBCRLF
Next
objTextFile.Write strIE & VBCRLF & VBCRLF & VBCRLF & VBCRLF
 
 
 
 
 
objTextFile.Write "MOTHERBOARD" & VBCRLF 
 
'===============================================================
'Get Main Board Information
Set colItems = objWMIService.ExecQuery("Select * from Win32_BaseBoard",,48)
For Each objItem in colItems
objTextFile.Write " MAINBOARD MANUFACTURER: " & objItem.Manufacturer & VBCRLF
objTextFile.Write " MAINBOARD PRODUCT: " & objItem.Product & VBCRLF
Next
 
 
 
'================================================================
'Get BIOS Information
Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS",,48)
For Each objItem in colItems
objTextFile.Write " BIOS MANUFACTURER: " & objItem.Manufacturer & VBCRLF
objTextFile.Write " BIOS VERSION: " & objItem.Version & VBCRLF & VBCRLF & VBCRLF & VBCRLF & VBCRLF
Next
 
objTextFile.Write "MEMORY" & VBCRLF 
 
'===================================================================
'Get Total Physical memory
Set colSettings = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings
objTextFile.Write " TOTAL PHYSICAL RAM: " & Round((objComputer.TotalPhysicalMemory/1000000000),4) & " GB" & VBCRLF
Next
 
objTextFile.Write " " & VBCRLF & VBCRLF & VBCRLF & VBCRLF & "PARTITIONS" & VBCRLF 
 
'===================================================================
'Get Logical Disk Size and Partition Information
Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = 3")
For Each objDisk in colDisks
intFreeSpace = objDisk.FreeSpace
intTotalSpace = objDisk.Size
pctFreeSpace = intFreeSpace / intTotalSpace
objTextFile.Write " DISK " & objDisk.DeviceID & " (" & objDisk.FileSystem & ") " & Round((objDisk.Size/1000000000),4) & " GB ("& Round((intFreeSpace/1000000000)*1.024,4) & " GB Free Space)" & VBCRLF
Next
 
objTextFile.Write " " & VBCRLF & VBCRLF & VBCRLF & VBCRLF & "NETWORK" & VBCRLF 
 
'====================================================================
'Get NETWORK ADAPTERS information
Dim strIP, strSubnet, strDescription
 
Set colNicConfigs = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
For Each objNicConfig In colNicConfigs
'Assign description values to variable
strDescription=objNicConfig.Description
 
For Each strIPAddress In objNicConfig.IPAddress
'Assign IP Address to variable
strIP=strIPAddress 
 
For Each strIPSubnet In objNicConfig.IPSubnet
'Assign Subnet to variable
strSubnet = strIPSubnet
Next
 
objTextFile.Write " NETWORK ADAPTER: " & strDescription & VBCRLF
objTextFile.Write " IP ADDRESS: " & strIP & VBCRLF
objTextFile.Write " SUBNET MASK: " & strSubnet & VBCRLF & VBCRLF
 
Next
 
Next
 
Set colNicConfigs =NOTHING
 
 
'============================================================
 
objTextFile.Write " " & VBCRLF & VBCRLF & VBCRLF & VBCRLF & "APPLICATION" & VBCRLF 
 
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
 
For Each subkey In arrSubKeys
strSubKeyPath = strKeyPath & "\" & subkey
 
strString = "DisplayName"
objReg.GetStringValue HKEY_LOCAL_MACHINE, strSubKeyPath, strString, strDisplayName
 
strString = "DisplayVersion"
objReg.GetStringValue HKEY_LOCAL_MACHINE, strSubKeyPath, strString, strDisplayVersion
 
strDisplayName=Trim(strDisplayName)
strDisplayVersion=Trim(strDisplayVersion)
If strDisplayName <> "" And strDisplayVersion <> "" Then
objTextFile.Write " " & strDisplayName & " " & strDisplayVersion & VBCRLF
End If
Next
 
 
'===========================================
 
 
 
'Close text file after writing logs
 
objTextFile.Write VbCrLf
objTextFile.Close
 
'Clean Up
 
SET colIESettings=NOTHING
SET colItems=NOTHING
SET colSettings=NOTHING
SET colDisks=NOTHING
SET AdapterSet=NOTHING
SET objWMIService=NOTHING
SET objWMIService2=NOTHING
SET objFSO=NOTHING
SET objTextFile=NOTHING
 
 
'===================================================================
END SUB
 
 
 
Function HostOnline(strComputername)
 
 
Set sTempFolder = objFso.GetSpecialFolder(TEMPFOLDER)
sTempFile = objFso.GetTempName
sTempFile = sTempFolder & "\" & sTempFile
 
objShell.Run "cmd /c ping -n 2 -l 8 " & strComputername & ">" & sTempFile,0,True
 
Set oFile = objFso.GetFile(sTempFile)
set oTS = oFile.OpenAsTextStream(ForReading)
do while oTS.AtEndOfStream <> True
sReturn = oTS.ReadLine
if instr(sReturn, "Reply")>0 then
HostOnline = True
Exit Do
End If
Loop
 
ots.Close
oFile.delete
End Function

Open in new window

0
cullyk
Asked:
cullyk
  • 6
  • 5
1 Solution
 
Mark PavlakCommented:
Here are some snippets I use for Server documentation.  I think you will find everything here but the SQL  pieces,  have not had to write those yet.  You will need to modify them to fit your needs as I use them to wirte into a spread sheet using an excel object


Sub  Win32_NetworkAdapterConfiguration (strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim arrIP
Dim intArraySize,intPlace
'=============================================================================================
'Initalize WMI
'=============================================================================================
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(1,intCount).value = "MAC Address on Adapter "&intPlace
		objWorkSheet.cells(2,intCount).value = objPCAttribute.MACAddress
       ' wscript.echo "IP Addresses: "&Join(objPCAttribute.IPAddress, "  ")
        
       intArraySize = UBound (objPCAttribute.IPAddress)+ 1
       Do While intArraySize <> 0
       intCount = intCount + 1
       	objWorkSheet.cells(1,intCount).value = "IP Address "&intPlace+1
      	objWorkSheet.cells(2,intCount).value = objPCAttribute.IPAddress(intPlace)
      	intPlace = intPlace + 1
      	intArraySize = intArraySize - 1
       Loop
    End If
'=============================================================================================
Next
End Sub
 Win32_LogicalDisk(strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim arrIP
'=============================================================================================
'Initalize WMI
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_LogicalDisk")
'=============================================================================================
'Get Attribues from Win32_LogicalDisk
'=============================================================================================
For Each objPCAttribute In objPC
	If objPCAttribute.Description = "Local Fixed Disk" Then
		intCount = intCount + 1
		objWorkSheet.cells(1,intCount).value = "Drive Letter"
		objWorkSheet.cells(2,intCount).value =objPCAttribute.DeviceID
		intCount = intCount + 1
		objWorkSheet.cells(1,intCount).value = "Dive Size"
		objWorkSheet.cells(2,intCount).value =  FormatNumber(objPCAttribute.Size/1073741824,2)+"gigs"
	End If
Next
End Sub
Sub Win32_ComputerSystem (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_ComputerSystem")
'=============================================================================================
'Get Attribues from WIN32_Computersystem
'=============================================================================================
For Each objPCAttribute In objPC
	intCount = intCount + 1
	objWorkSheet.cells(1,intCount).value = "Model" 
	objWorkSheet.cells(2,intCount).value =  objPCAttribute.model
	intCount = intCount + 1
	objWorkSheet.cells(1,intCount).value = "RAM"
	objWorkSheet.cells(2,intCount).value =  FormatNumber(objPCAttribute.TotalPhysicalMemory/1073741824,2)+"gigs"   
	intCount = intCount + 1
	objWorkSheet.cells(1,intCount).value = "Manufacturer"
	objWorkSheet.cells(2,intCount).value = objPCAttribute.Manufacturer
	intCount = intCount + 1
	objWorkSheet.cells(1,intCount).value = "Number of Processors"
	objWorkSheet.cells(2,intCount).value = objPCAttribute.NumberOfProcessors
	
Next
'=============================================================================================
End Sub
Sub  Win32_NetworkAdapterConfiguration (strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim arrIP
Dim intArraySize,intPlace
'=============================================================================================
'Initalize WMI
'=============================================================================================
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(1,intCount).value = "MAC Address on Adapter "&intPlace
		objWorkSheet.cells(2,intCount).value = objPCAttribute.MACAddress
       ' wscript.echo "IP Addresses: "&Join(objPCAttribute.IPAddress, "  ")
        
       intArraySize = UBound (objPCAttribute.IPAddress)+ 1
       Do While intArraySize <> 0
       intCount = intCount + 1
       	objWorkSheet.cells(1,intCount).value = "IP Address "&intPlace+1
      	objWorkSheet.cells(2,intCount).value = objPCAttribute.IPAddress(intPlace)
      	intPlace = intPlace + 1
      	intArraySize = intArraySize - 1
       Loop
    End If
'=============================================================================================
Next
End Sub

Open in new window

0
 
cullykAuthor Commented:
Hi jfinner2,

That looks to be on the right track but can you include the code that opens the sheet etc?
I will use the code you have there and try and write the SQL parts. I will post back here when I have something working.

Regards,
cullyk
0
 
Mark PavlakCommented:
Here is an example of the snippets in use.  I have it several ways.  One way to rip through AD and doing this per Server and one that runs locally.  here is the one to run local.  I hope this helps for you.  If you need to run this remotely subitute either IP or FQDN for the strComputer to that IP or  FQDN.  If you dont want to watch the spread sheet be created then in the sub Initialize_Excel change the line .Visible=true to False
'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
'
' NAME:  Server Info for Critical Binder
'
' AUTHOR: John Finner , Gateway Bank and Trust
' DATE  : 9/10/2008
'
' COMMENT: 
'
'==========================================================================
'Globals
'=============================================================================================
Dim objExcel,objWorkSheet,objWord
Dim strComputer,strTemplate,strLocation,x,y,strProcessorNum
Dim IntRow
'=============================================================================================
'Initalize Globals
'=============================================================================================
Set objExcel = CreateObject("Excel.Application")
Set objWord = CreateObject ("Word.Application")
strComputer = "."
strTemplate = "c:\Server.dot"
strLocation = "Operations"
IntRow = 11
x = 7
y = 8
'=============================================================================================
initialize_ObjExcel
Initializae_ObjWord
initialize_objWorkSheet(strComputer)
Win32_SystemEnclosure(strComputer)
Win32_ComputerSystem(strComputer)
Win32_Processor(strComputer)
Win32_NetworkAdapterConfiguration (strComputer)
'Win32_Product(strComputer)
Win32_LogicalDisk(strComputer)
Win32_OperatingSystem(strComputer)
objWord.ActiveDocument.SaveAs "C:\Documents and Settings\johnfinner\Desktop\Server Documentation\"&UCase(strComputer)&".doc"
Sub Initializae_ObjWord
With objWord
	.visible = True
	.Documents.open strTemplate
	.ActiveDocument.BookMarks("ServerName").select
	.Selection.text = UCase(strComputer)
	.ActiveDocument.BookMarks("Location").select
	.Selection.text = strLocation
	End With
End Sub
Sub initialize_objWorkSheet (strComputerAccount)
	objExcel.Worksheets.Add,,1
	Set objWorkSheet = objExcel.Worksheets(1)
	objWorkSheet.name = strComputer
	
	objWorkSheet.cells(1,1).value ="Type"
	objWorkSheet.cells(2,1).value ="Serial Number"
	objWorkSheet.cells(3,1).value ="Server Model"
	objWorkSheet.cells(4,1).value ="Manufactuer"
	objWorkSheet.cells(5,1).value ="RAM"
	objWorkSheet.cells(6,1).value ="Number of Processors"
	objWorkSheet.cells(14,13).value ="Application"
	objWorkSheet.cells(14,14).value ="Verision"
End Sub
Sub initialize_ObjExcel ()
	With objExcel
		.Visible = True
		.Workbooks.add()
		.Worksheets(1).delete
		.Worksheets(2).delete
		End with
End Sub
Sub Win32_SystemEnclosure(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_SystemEnclosure")
'=============================================================================================
'Get Attribues from WIN32_SystemEnclosure
'=============================================================================================
For Each objPCAttribute In objPC
	objWorkSheet.cells(2,2).value = objPCAttribute.SerialNumber
next
End sub
Sub Win32_ComputerSystem (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_ComputerSystem")
'=============================================================================================
'Get Attribues from WIN32_Computersystem
'=============================================================================================
For Each objPCAttribute In objPC
	objWorkSheet.cells(3,2).value =  objPCAttribute.model
	objWorkSheet.cells(5,2).value =  FormatNumber(objPCAttribute.TotalPhysicalMemory/1073741824,2)+"gigs"   
	objWorkSheet.cells(4,2).value = objPCAttribute.Manufacturer
	If (objPCAttribute.Manufacturer = "VMware, Inc.") Then
		objWorkSheet.cells(1,2).value = "Virtual"
		Else
		objWorkSheet.cells(1,2).value = "Physical"
	End if
	strProcessorNum = objPCAttribute.NumberOfProcessors
	Next
'=============================================================================================
End Sub
Sub Win32_Processor(strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim intCount,strClockSpeed
intCount = 3
'=============================================================================================
'Initalize WMI
'=============================================================================================
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(6,2).value = strProcessorNum&" @ "&strClockSpeed
End Sub
Sub  Win32_NetworkAdapterConfiguration (strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim arrIP
Dim intArraySize,intPlace
'=============================================================================================
'Initalize WMI
'=============================================================================================
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(x,intCount).value = "MAC Address"
		objWorkSheet.cells(y,intCount).value = objPCAttribute.MACAddress
       ' wscript.echo "IP Addresses: "&Join(objPCAttribute.IPAddress, "  ")
        
       intArraySize = UBound (objPCAttribute.IPAddress)+ 1
       Do While intArraySize <> 0
       intCount = intCount + 1
       	objWorkSheet.cells(x,intCount).value = "IP Address "&intPlace+1
      	objWorkSheet.cells(y,intCount).value = objPCAttribute.IPAddress(intPlace)
      	intPlace = intPlace + 1
      	intArraySize = intArraySize - 1
       Loop
    End If
    x = x + 2
    y = y + 2
    intCount = 0
'=============================================================================================
Next
End Sub
Sub Win32_Product (strComputerAccount)
intcount = 15
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputerAccount & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
    ("Select * from Win32_Product")
 
For Each objSoftware in colSoftware
   objWorkSheet.cells(intCount,13).value =objSoftware.Name
    objWorkSheet.cells(intCount,14).value =objSoftware.Version
    intCount = intCount + 1
Next
End Sub
Sub Win32_OperatingSystem (strComputerAccount)
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputerAccount & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
 
For Each objSoftware in colSoftware
   	objWord.ActiveDocument.BookMarks("Platform").select
	objWord.Selection.text = objSoftware.Caption+" "+objSoftware.CSDVersion
   
Next
End Sub
sub Win32_LogicalDisk(strComputerAccount)
On Error Resume Next
'Variables
'=============================================================================================
Dim objWMI,objPCAttribute,objPC
Dim arrIP
intCount = 0
x = FindEndOfSheet(objWorkSheet)
'=============================================================================================
'Initalize WMI
'=============================================================================================
Set objWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputerAccount & "\root\cimv2")
Set objPC = objWMI.ExecQuery _
    ("Select * from Win32_LogicalDisk")
'=============================================================================================
'Get Attribues from Win32_LogicalDisk
'=============================================================================================
objWorkSheet.cells(x,1).value = "Drive Letter"
objWorkSheet.cells(x,2).value = "Drive Size"
x = x+1
For Each objPCAttribute In objPC
	If objPCAttribute.Description = "Local Fixed Disk" Then
		intCount = intCount + 1
		objWorkSheet.cells(x,intCount).value =objPCAttribute.DeviceID
		intCount = intCount + 1
		objWorkSheet.cells(x,intCount).value =  FormatNumber(objPCAttribute.Size/1073741824,2)+"gigs"
		x = x+1
		intCount = 0
	End If
Next
End Sub
Function FindEndOfSheet (objTempSheet)
Dim strEOS
strEOS = 1
Do Until Len(objTempSheet.cells(strEOS,1).value) = 0
	strEOS = strEOS + 1
Loop
FindEndOfSheet = strEOS
End Function

Open in new window

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
cullykAuthor Commented:
Hi jfinner2,

I would like to see this script in action, could you upload an example of the c:\Server.dot file so I can run this script?? Is that the only file required?

Regards
0
 
Mark PavlakCommented:
I am sorry I have been sick.  I have uploaded the final variaent of the script I sent you this one only requires Excel with no files
<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
 
cullykAuthor Commented:
Hi jfinner2,

Looks ok, this would be a HTA application right? Do you have the Server.xlt template?
It doesnt run very well without it.

Regards
0
 
Mark PavlakCommented:
Yes it is and yes I do see attached.  You will need to rename to .xlt as this site would not allow me to upload a template
Server.xls
0
 
cullykAuthor Commented:
Hi jfinner,
It just seems to be a blank file, is this correct?
I am closing this question now and will award you points for your help.
Thanks
0
 
Mark PavlakCommented:
Yes I work for A bank.  I am guessing that one had the logo and Co. Name embedded in the header.  I am glad this has been helpful for you.  
0
 
cullykAuthor Commented:
Blank file.. not bank file.
The template... it is blank. Nothing in it.
0
 
Mark PavlakCommented:
View the head and footer.  It was easier for me to create a template then to dynamically create it via script.  Sorry,  I havent had my can of crack yet and I am half awake
0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now