locked
Harvesting asset info and output to CSV RRS feed

  • Question

  • I need a script modified that will run on all servers in a work group in order to gather asset data on the appliances running Windows Server 2000 embedded edition. There are no domain services and these systems and this network technology is not an option in our environment due to proprietary security, networking and infrastructure restrictions. I have found a script that works but i need it modified to output to a csv as it wont output and .xls .xlsx properly. The script will be run on the only computer on the network that can access these devices. Any help on this would be awesome.

                   

    ' *******************************
    ' Get Windows Server Information
    ' Written By Kely Mulcahey, E.C.S. LLC.
    ' Created: March 1, 2006
    ' Version: 3.0, Revised 5/30/2014
    ' *******************************
    
    On Error Resume Next
    Dim PUBOSVer ' Global OS Version
    
    ' Open File For Writing
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    Const ForReading = 1
    
    
    ' Get Server List
    strServerFilename = "servers.txt"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(strServerFilename) Then
    	' Open Servers File
    	Set objServers = objFSO.OpenTextFile(strServerFilename, ForReading)
    Else
    	' Server File is missing: Exit
    	intMsg = MsgBox("File: " & Chr(34) & UCASE(strServerFilename) & Chr(34) & _
    				" is either " & _ 
    				"Missing or Damaged!" & vbcrlf & _
    				vbcrlf & _
    				"This Script will now Exit.", vbCritical, "Server File Error")
    	WScript.Quit(0)
    End If
    
    
    Do Until objServers.AtEndOfStream
       	strNewServer = Trim(objServers.ReadLine)
       	strServerList = strServerList & strNewServer & vbcrlf
        intServerCnt = intServerCnt + 1
    Loop
    
    
    ' Enumerate Server Array
    For a = 0 To intServerCnt - 1
    	strServer = Split(strServerList, vbcrlf)
    Next
    
    
    ' ******************************
    	
    ' Create Excel Spreadsheet
    Set objXLA = CreateObject("Excel.Application")
    objXLA.Visible = False
    objXLA.DisplayAlerts = False
    Set objWorkbook = objXLA.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)
    
    'Excel Constants
    Const xlEdgeLeft = 7
    Const xlContinuous = 1
    Const xlNone = -4142
    Const xlMedium = -4138
    Const xlThin = 2
    
    		
    'Set Headers
    ' System Information
    objXLA.Cells(1,1).Value = "Service ID"
    objXLA.Cells(1,2).Value = "Company Name"
    objXLA.Cells(1,3).Value = "Manufacturer"
    objXLA.Cells(1,4).Value = "Model"
    objXLA.Cells(1,5).Value = "Operating System"
    
    ' Processors
    objXLA.Cells(1,6).Value = "Processor Type"
    objXLA.Cells(1,7).Value = "Processors"
    
    ' RAM
    objXLA.Cells(1,8).Value = "RAM"
    objXLA.Cells(1,9).Value = "Slots"
    objXLA.Cells(1,10).Value = "Max Capacity"
    
    ' Network
    objXLA.Cells(1,11).Value = "NIC Port"
    objXLA.Cells(1,12).Value = "Speed"
    objXLA.Cells(1,13).Value = "Connection Name"
    objXLA.Cells(1,14).Value = "Primary IP"
    objXLA.Cells(1,15).Value = "Virtual IP"
    objXLA.Cells(1,16).Value = "Primary DNS"
    objXLA.Cells(1,17).Value = "Secondary DNS"
    
    ' Hard Disks
    objXLA.Cells(1,18).Value = "Interface"
    objXLA.Cells(1,19).Value = "Physical Disks"
    objXLA.Cells(1,20).Value = "Disk Size"
    objXLA.Cells(1,21).Value = "Fault Tolerant"
    objXLA.Cells(1,22).Value = "Hot Spare"
    
    ' Set Top Line
    objXLA.Cells(1, 1).EntireRow.Font.Bold = True
    objXLA.Cells(1, 1).EntireRow.Font.Underline = True
    
    
    ' ******************************
    
    
    For b = 0 To UBound(strServer) - 1
    
    	strServerParts = Split(strServer(b), " ")
    
    	strComputer = strServerParts(0)
    
    	' Parse Server Information 
    	If UBound(strServerParts) = 2 Then
    		strUsername = Trim(strServerParts(1))
    		strPassword = Trim(strServerParts(2))
    	End If
    
    
    	' Create Connection Object
    	Set objWMIService = Nothing
    	Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
    	Set objWMIService = objSWbemLocator.ConnectServer _
    	    (strComputer, "root\cimv2", strUsername, strPassword)
    	objWMIServices.Security_.ImpersonationLevel = 3	
    
    	
    	' Check if Server Exists
    	For intWMICheck = 0 To 15
    		If Not objWMIService Is Nothing Then
    			Exit For
    		Else
    			WScript.Sleep(1000)
    		End If
    	Next
    
    
    	' Server Exists
    	If intWMICheck < 15 Then
    	
    		' Get CPU Information			
    		Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    		
    		For Each colProc In colProcessor
    			strManuf = colProc.Manufacturer
    			strDescription = ProcessorName(colProc.Name)
    			strClockSpeed = colProc.CurrentClockSpeed
    			strSocket = strSocket & colProc.SocketDesignation & vbcrlf
    			strProcID = strProcID & colProc.ProcessorID & vbcrlf
    			strUniqueID = strUniqueID & colProc.UniqueID & vbcrlf
    			ProcCount = ProcCount + 1
    		Next
    		
    		' Determine if Hyperthreading is Enabled
    		strHTStatus = GetHTStatus(strSocket, ProcCount, strProcID, strUniqueID)
    		
    		
    		' DC / HT Results
    		If strHTStatus = "True"	Then
    			If InStr(strManuf, "Intel") Then
    				strDescription = strDescription & " (Dual Core or H/T)"
    			Else
    				strDescription = strDescription & " (Dual Core)"
    			End If
    			
    			ProcCount = ProcCount / 2
    		End If
    		
    				
    		'--------------
    		
    		' Export Information
    		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    		Set colCS = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
    		
    		' Write Basic System Information
    		For Each objItem in colCS
    		
    			Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
    			For Each objItemOS in colOS
    			
    				' Get SP Version
    				If objItemOS.CSDVersion <> "" Then
    					strSPVersion = objItemOS.CSDVersion
    				Else
    					strSPVersion = "No Service Packs Installed"
    				End If
    				
    				If objItemOS.LastBootUpTime <> "" Then
    					strLastBoot = DateConvert(objItemOS.LastBootUpTime)
    				Else
    					strLastBoot = "N/A"
    				End If
    				
    				' Set OS Version Information
    				PUBOSVer = objItemOS.Caption
    			
    				objXLA.Cells(b + 2, 1).Value = objItemOS.csname
    				objXLA.Cells(b + 2, 3).Value = objItem.Manufacturer
    				objXLA.Cells(b + 2, 4).Value = objItem.Model
    				objXLA.Cells(b + 2, 5).Value = PUBOSVer & " - " & strSPVersion
    				objXLA.Cells(b + 2, 6).Value = strDescription
    				objXLA.Cells(b + 2, 7).Value = ProcCount
    				objXLA.Cells(b + 2, 8).Value = MemoryConvert(objItem.TotalPhysicalMemory)				
    			Next
    		Next
    		
    		
    		' Get Memory Breakdown
    		Dim strMemBreak
    		strMemBreak = Split(MemoryBreakdown(), vbcrlf)
    		
    		n = 0
    		For n = 0 To UBound(strMemBreak) - 1
    			strSlots = strSlots & strMemBreak(n) & Chr(10)
    		Next
    		
    		strMaxCapacity = strMemBreak(UBound(strMemBreak))
    		
    		objXLA.Cells(b + 2, 9).Value =  Left(strSlots, Len(strSlots) - 1)
    		objXLA.Cells(b + 2, 10).Value =  strMaxCapacity
    		
    		' Dispose
    		strMemBreak = ""
    		strMaxCapacity = ""
    		strSlots = ""
    		
    		'--------------Computer Information (End)------------------'
    		
    		'-------------Partition Information (Start)----------------'
    		
    				
    		' Get Drive Count
    		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    		Set DiskItemsParent = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
    		intCount = DiskItemsParent.Count
    		
    		' Process Drives
    		intDriveMark = 0
    		For i = 0 To intCount - 1
    			
    			Set DiskItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE Index = " & i)
    			
    			For Each diskItem in DiskItems
    				
    				' Convert Drive Size
    				If diskItem.Size <> "" Then strSize = strSize & ByteConvert(diskItem.Size) & Chr(10) Else strSize = "N/A" & Chr(10)
    				If diskItem.StatusInfo <> "" Then strStsInfo = diskItem.StatusInfo Else strStsInfo = "N/A"
    				If diskItem.SCSIBus <> "" Then strSCSIBus = diskItem.SCSIBus Else strSCSIBus = "N/A"
    				If diskItem.SCSILogicalUnit <> "" Then strSCSILog = diskItem.SCSILogicalUnit Else strSCSILog = "N/A"
    				If diskItem.SCSIPort <> "" Then strSCSIPort = diskItem.SCSIPort Else strSCSIPort = "N/A"
    				If diskItem.SCSITargetId <> "" Then strSCSITarget = diskItem.SCSITargetId Else strSCSITarget = "N/A"
    				
    				
    				' Get Model
    				strModel = Split(diskItem.Model, " ")
    				
    				' Detect HP Array
    				If (UCase(strModel(0)) = "HP" Or UCase(strModel(0)) = "COMPAQ") And intDriveMark = 0 Then
    					strGetHPArray = GetHPArray(strComputer, strUsername, strPassword)
    					
    					If strGetHPArray <> "" Then
    						strSplitHP = Split(strGetHPArray, Chr(13))
    									
    						For a = 0 To UBound(strSplitHP)
    							strSplitResult = Split(strSplitHP(a), ":")
    							i = i + 1
    							
    							strDriveCount = strDriveCount & Trim(strSplitResult(0)) & Chr(10)
    							strDriveSize = strDriveSize & Trim(strSplitResult(1)) & Chr(10)
    							strDriveFault = strDriveFault & Trim(strSplitResult(2)) & Chr(10)
    							strDriveSpare = strDriveSpare & Trim(strSplitResult(3)) & Chr(10)
    							strInterface = strInterface & "HP SCSI" & Chr(10)							
    						Next
    						
    						' Set Controller Output
    						objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    						objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
    						objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    						objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    						
    						intDriveMark = 1 ' Mark That Data was Obtained
    					
    					Else
    					
    						strDriveCount = strDriveCount & "1" & Chr(10)
    						strDriveSize = strDriveSize & strSize & Chr(10)
    						strDriveFault = strDriveFault & "N/A" & Chr(10)
    						strDriveSpare = strDriveSpare & "N/A" & Chr(10)
    						strInterface = strInterface & "HP SCSI " & Chr(10)
    						
    						' Set Controller Output
    						intDriveMark = 1 ' Mark That Another Pass is Invalid
    						
    						' Set Controller Output
    						objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    						objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
    						objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    						objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    					End If
    					
    				Else
    					strDriveCount = strDriveCount & "1" & Chr(10)
    					strDriveSize = strDriveSize & strSize & Chr(10)
    					strDriveFault = strDriveFault & "N/A" & Chr(10)
    					strDriveSpare = strDriveSpare & "N/A" & Chr(10)
    						
    					' Set Controller Output
    					intDriveMark = 1 ' Mark That Another Pass is Invalid
    						
    					' Set Controller Output
    					objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    					objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))	
    					objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    					objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    				
    				
    					' Set Interface
    					If diskItem.InterfaceType = "IDE" Then
    						strInterface = strInterface & "ATA" & Chr(10)						
    					Else
    						strInterface = strInterface & "SATA/SCSI" & Chr(10)
    					End If			
    				End If
    				
    				' Set Cell Value "Interface"
    				objXLA.Cells(b + 2, 18).Value = Left(strInterface, Len(strInterface) - 1)
    			Next
    			
    			' Dispose Drive Sizes
    			strDriveSize = ""
    		Next
    		
    		' Dispose Drive Values
    		strDriveCount = ""
    		strDriveFault = ""
    		strDriveSpare = ""
    		strInterface = ""
    		
    		'----Partition Information (End)---------------------------'
    		
    		
    		
    		'----Network Information (Start)---------------------------'
    		
    	
    		Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
    		
    		i = 1
    		eth = 0
    		Dim STOREDIP(0)
    		intNum = 0
    		
    		For Each objItem in colItems
    		
    			If objItem.NetConnectionStatus <> "" Then
    				
    				' Determine Connection Status
    				If objItem.NetConnectionStatus = 0 Then
    					strNetStat = "Disabled"
    				ElseIf objItem.NetConnectionStatus = 2 Then
    					strNetStat = "Connected"
    				ElseIf objItem.NetConnectionStatus = 7 Then
    					strNetStat = "Disconnected"
    				Else
    					strNetStat = "Unknown"
    				End If
    				
    				If objItem.NetConnectionStatus <> 0 Then
    				
    					' Get Network Card Information
    					Const HKEY_LOCAL_MACHINE = &H80000002
    					strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
    					strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
    					strHostEntry = "Hostname"
    					strDomainEntry = "Domain"
    					strNodeEntry = "DhcpNodeType"
    					strRoutingEntry = "IPEnableRouter"
    		 
    					Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    		 				strComputer & "\root\default:StdRegProv")
    					objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strHostEntry,strHostname
    					objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strDomainEntry,strDomain
    					objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strNodeEntry,dwNodeType
    					objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath1,strRoutingEntry,dwIPRouting
    			 
    					Select Case dwNodeType
    			  			Case 4 strNodeType = "Mixed"
    		  				Case 8 strNodeType = "Hybrid"
    		  				Case Else strNodeType = dwNodeType
    					End Select
    		
    					If dwIPRouting = 0 Then
    		  				strIPRouting = "No"
    					ElseIf dwIPRouting = 1 Then
    			  			strIPRouting = "Yes"
    					Else
    			  			strIPRouting = "?"
    					End If
    		 
    					Set colFirstNicConfig = objWMIService.ExecQuery _
    		 				("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    				
    					For Each objFirstNicConfig In colFirstNicConfig
    		  				strDnsWins = objFirstNicConfig.DNSEnabledForWINSResolution
    					Next
    			
    					Set colNicConfigs = objWMIService.ExecQuery _
    			  			("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    				
    					 
    					' Display per-adapter settings.	
    					For Each objNicConfig In colNicConfigs
    			  			intIndex = objNicConfig.Index
    		 				Set objNic = objWMIService.Get("Win32_NetworkAdapter.DeviceID=" & intIndex)
    		 
    		  				' Connection Name
    		  				If GetOsVer > 5 Then
    		  					' Works only in XP / 2003
    			    			strNetConn = objNic.NetConnectionID				
    		  				ElseIf GetOsVer = 5 Then
    							strNetConn = ""
    		  					' Get Home Drive of Remote Server
    							Set objShell = CreateObject("WScript.Shell")
    							Set objEtherName = objShell.Exec("cmd /c ipconfig | find " & Chr(34) & "Ethernet" & Chr(34))
    						
    							strEtherName = objEtherName.StdOut.ReadAll()					
    							strEtherParse = Split(strEtherName, Chr(13))
    		    				strEtherConn = Split(strEtherParse(eth), " ")
    		    				
    		    				For y = 2 To UBound(strEtherConn)
    		    					strNetConn = strNetConn & " " & strEtherConn(y)
    		    				Next
    		    				
    		    				' Trim Connection Name
    		    				strNetConn = Left(Trim(strNetConn), Len(Trim(strNetConn)) - 1)
    		    			Else
    		    				strNetConn = ""
    						End If
    						
    							 				
    		 				' IP Addresses
    		  				strIPAddresses = ""
    		  			
    		  				If Not IsNull(objNicConfig.IPAddress) Then
    		  	    			For Each strIPAddress In objNicConfig.IPAddress
    		      					strIPAddresses = strIPAddresses & strIPAddress & " "
    		    				Next
    		  				End If
    		  				
    		  				strIPCollection = Split(strIPAddresses, " ")
    		  				    	
    		  				  		
    		  				' Subnets
    						strIPSubnets = ""
    		  
    		  				If Not IsNull(objNicConfig.IPSubnet) Then
    		    				For Each strIPSubnet In objNicConfig.IPSubnet
    			      				strIPSubnets = strIPSubnets & strIPSubnet & " "
    		    				Next
    		  				End If
    		  
    		  				strSMCollection = Split(strIPSubnets, " ")
    		  
    		  				
    		  				' Virtual IP's  	
    		  				strVirtual = ""
    		  				
    		  				If UBound(strIPCollection) > 1 Then
    							For IPCount = 1 To UBound(strIPCollection) - 1
    								strVirtual = strVirtual & (strIPCollection(IPCount) & " / " & strSMCollection(IPCount)) & Chr(10)
    							Next
    							strVirtual = Left(strVirtual, Len(strVirtual) - 1)					
    						End If
    						
    						If Trim(strVirtual) = "" Then strVirtual = "N/A"
    		  
    		  
    		  				' Gateways
    		  				strDefaultIPGateways = ""
    		  				If Not IsNull(objNicConfig.DefaultIPGateway) Then
    		    				For Each strDefaultIPGateway In objNicConfig.DefaultIPGateway
    		      					strDefaultIPGateways = strDefaultIPGateways & strDefaultIPGateway & " "
    			    			Next
    			    		Else
    			    			strDefaultIPGateways = "N/A"
    		  				End If
    		  		
    		  				'--------------------------------------
    		  					
    		  				' If IP is repeated, and was already reported.
    		  				
    		  				intSkipLoop = 0
    		  				If Trim(strNetConn) <> "" Then
    		  					For j = 0 To intNum - 1
    		  						If STOREDIP(j) = strIPAddresses Then
    									intSkipLoop = 1
    		  							Exit For
    		  						End If
    		  					Next
    														
    				  			If intSkipLoop = 0 Then
    								ReDim Preserve STOREDIP(intNum)
    								STOREDIP(intNum) = strIPAddresses	
    								intNum = intNum + 1  				
    			  				End If
    			  			Else
    			  				intSkipLoop = 1
    			  			End If
    			  			
    		  				  
    						' DNS
    		  				strDNSServerSearchOrder = ""
    		  			
    		  				If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
    			    			For Each strDNSServer In objNicConfig.DNSServerSearchOrder
    		      					strDNSServerSearchOrder = strDNSServerSearchOrder & strDNSServer & " "
    		      				Next
    		    				
    		    				strDNS = Split(strDNSServerSearchOrder, " ")
    		    				
    		    				strDNS1 = strDNS(0)
    		    				If Trim(strDNS1) = "" Then strDNS1 = "N/A"
    
    							If UBound(strDNS) > 1 Then
    		    					strDNS2 = strDNS(1)
    							Else
    								strDNS2 = "N/A"
    							End If
    		  				Else
    			  				strDNS1 = "N/A"
    			  				strDNS2 = "N/A"
    		  				End If
    		  				
    						
    						' Run Output Process
    						If intSkipLoop = 0 Then		
    							
    							' Connection Speed
    							strSpeed = "Unknown"
    							
    							Set objWMIService2 = objSWbemLocator.ConnectServer _
    	    						(strComputer, "root\WMI", strUsername, strPassword)
    								objWMIServices.Security_.ImpersonationLevel = 3	
    												
    							Set listAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_LinkSpeed")		
    							Set enumAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_EnumerateAdapter")		
    							
    							For Each objAdapter in listAdapters
    								For Each objEnum in enumAdapters
    									intEnum = Len(objEnum.DeviceName)
    									
    									If objNicConfig.SettingID = Right(objEnum.DeviceName, intEnum - 8) Then
    										If objEnum.InstanceName = objAdapter.InstanceName Then   						
    				    						intLength = Len(objAdapter.NdisLinkSpeed/10000)
    				    						If intLength > 3 Then
    				    							strSpeed = Left(objAdapter.NdisLinkSpeed/10000, intLength - 3)
    				    							strSpeed = strSpeed & ".0 Gbps"
    				    						Else
    				    							strSpeed = objAdapter.NdisLinkSpeed/10000 & " Mbps"
    				    						End If  						
    			    						End If
    			    					End If
    		    					Next
    		   					Next
    
    							strTotalDesc = strTotalDesc & objNicConfig.Description & Chr(10)
    							strTotalSpeed = strTotalSpeed & strSpeed & Chr(10)
    							strTotalNetConn = strTotalNetConn & strNetConn & Chr(10)
    							strPrimaryIP = strPrimaryIP & strIPCollection(0) & " / " & strSMCollection(0) & Chr(10)
    							strDNSTotal1 = strDNSTotal1 & strDNS1 & Chr(10)
    							strDNSTotal2 = strDNSTotal2 & strDNS2 & Chr(10)
    							strTotalVirtual = strTotalVirtual & strVirtual & Chr(10)
    							
    							i = i + 1
    							eth = eth + 2
    							
    							' Dispose
    							strDescription = ""
    							ProcCount = 0
    							strClockSpeed = ""
    							strInterface = ""
    							intCount = 0
    							strSize = ""
    							strSpeed = ""
    							strIPCollection = ""
    							strVirtual = ""
    							strDNS = ""
    							strDNS1 = ""
    							strDNS2 = ""
    		    			End If
    					Next
    					
    					' Output
    					' Trim Leading Chr(10)
    					If Left(strPrimaryIP, 1) = Chr(10) Then strPrimaryIP = Right(strPrimaryIP, Len(strPrimaryIP) - 1)
    					If Left(strTotalVirtual, 1) = Chr(10) Then strTotalVirtual = Right(strTotalVirtual, Len(strTotalVirtual) - 1)
    					If Left(strDNSTotal1, 1) = Chr(10) Then strDNSTotal1 = Right(strDNSTotal1, Len(strDNSTotal1) - 1)
    					If Left(strDNSTotal2, 1) = Chr(10) Then strDNSTotal2 = Right(strDNSTotal2, Len(strDNSTotal2) - 1)
    					
    					objXLA.Cells(b + 2, 11).Value = Trim(Left(strTotalDesc, Len(strTotalDesc) - 1))
    					objXLA.Cells(b + 2, 12).Value = Trim(Left(strTotalSpeed, Len(strTotalSpeed) - 1))
    					objXLA.Cells(b + 2, 13).Value = Trim(Left(strTotalNetConn, Len(strTotalNetConn) - 1))					
    					objXLA.Cells(b + 2, 14).Value = Trim(Left(strPrimaryIP, Len(strPrimaryIP) - 1))
    					objXLA.Cells(b + 2, 15).Value = Trim(Left(strTotalVirtual, Len(strTotalVirtual) - 1))
    					objXLA.Cells(b + 2, 16).Value = Trim(Left(strDNSTotal1, Len(strDNSTotal1) - 1))
    					objXLA.Cells(b + 2, 17).Value = Trim(Left(strDNSTotal2, Len(strDNSTotal2) - 1))
    				End If
    			End If	
    			
    			' Dispose Per Loop
    			strTotalDesc = ""
    			strTotalSpeed = ""
    			strTotalNetConn = ""
    			strPrimaryIP = ""
    			strDNSTotal1 = ""
    			strDNSTotal2 = ""
    			strTotalVirtual	= ""
    			Set eth = 0
    			Set i = 0
    		Next
    		
    		'------------Network Information (End)------------------'
    
    		
    	Else
    		'No Data Present
    		objXLA.Cells(b + 2, 1).Value = strComputer
    		objXLA.Cells(b + 2, 3).Value = "Information Not Available"
    		objXLA.Cells(b + 2, 1).EntireRow.Font.Bold = True
    		objXLA.Cells(b + 2, 1).EntireRow.Interior.ColorIndex = 44
    	End If
    	
    
    	' Dispose Per Server
    	ProcCount = 0
    	strSocket = ""
    	strProcID = ""
    	strUniqueID = ""
    	Set objWMIService = Nothing
    Next
    
    
    
    '-----------------Functions (Start)---------------------'	
    
    ' System Memory Conversion
    Function MemoryConvert(strMem)
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
                            
        If (intLength Mod 4 = 0) Then
            intExp = CInt((intLength / 3) - 2)
        Else
            intExp = CInt((intLength / 3) - 1)
        End If
            
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead) 
                        
        intSize = CLng(strMem / (2 ^ (intExp * (10))))
                            
        If Len(intSize) = 1 Then
         	strFormat = FormatNumber(CStr(intSize), 2)
        Else
          	strFormat = intSize + 1
        End If
                                    
        If (intExp = 1) Then
            strMeasure = "KB"
        ElseIf (intExp = 2) Then
            strMeasure = "MB"
        ElseIf (intExp = 3) Then
            strMeasure = "GB"
        ElseIf (intExp = 4) Then
            strMeasure = "TB"
        ElseIf (intExp = 5) Then
            strMeasure = "PB"
        ElseIf (intExp = 6) Then
            strMeasure = "EB"
        End If
            
        MemoryConvert = strFormat & " " & strMeasure
    End Function
    
    
    
    ' System Byte Conversion
    Function ByteConvert(strMem)
    	
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
        
        If (intLength Mod 3 = 0) Then
            intExp = (intLength / 3) - 1
        Else
            intExp = (intLength / 3)
        End If
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead)                       
        intSize = CLng(strMem / (2 ^ (intExp * (10))))                    
       	strFormat = FormatNumber(CStr(intSize), 2)
                                    
        If (intExp = 1) Then
            strMeasure = "KB"
        ElseIf (intExp = 2) Then
            strMeasure = "MB"
        ElseIf (intExp = 3) Then
            strMeasure = "GB"
        ElseIf (intExp = 4) Then
            strMeasure = "TB"
        ElseIf (intExp = 5) Then
            strMeasure = "PB"
        ElseIf (intExp = 6) Then
            strMeasure = "EB"
        End If
            
        ByteConvert = strFormat & " " & strMeasure
    End Function
    
    
    
    ' System RAID Byte Conversion
    Function ByteConvertRAID(strMem)
    	
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
        
        If (intLength Mod 3 = 0) Then
            intExp = (intLength / 3) - 1
        Else
            intExp = (intLength / 3)
        End If
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead)                       
        intSize = (strMem / (2 ^ (intExp * (10))))                    
       	strFormat = FormatNumber(CStr(intSize), 2)
        
    	If (intExp = 0) Then
            strMeasure = "MB"                                
        ElseIf (intExp = 1) Then
            strMeasure = "GB"
        ElseIf (intExp = 2) Then
            strMeasure = "TB"
        ElseIf (intExp = 3) Then
            strMeasure = "PB"
        ElseIf (intExp = 4) Then
            strMeasure = "EB"
        End If
            
        ByteConvertRAID = strFormat & " " & strMeasure
    End Function
    
    
    
    ' Trim Processor Description
    Function ProcessorName(strName)
    
    	Dim intCounter
    	Dim strRead
    	Dim chrRead, chrReadMore
    	
    	For intCounter = 1 to Len(strName)
    		chrRead = Mid(strName, intCounter, 1)
    		chrReadMore = Mid(strName, intCounter + 1, 1)
    		If ((chrRead <> " ") Or ((chrRead = " ") And (chrReadMore <> " "))) Then
    			strRead = strRead & chrRead
    		End If
    	Next
    	
    	ProcessorName = Trim(strRead)
    End Function
    
    
    
    ' Get Hyper-Threading Status
    Function GetHTStatus(strName, intProc, strID, strUnique)
    	
    	strNameArray = Split(strName, vbcrlf)
    	strIDArray = Split(strID, vbcrlf)
    	strUniqueList = Split(strUnique, vbcrlf)
    	intTotal = 0
    		
    		
    	' Check Socket Designation
    	For i = 0 To UBound(strNameArray) - 1
    		intMark = 1
    		
    		' Check for Redundancies
    		For j = i + 1 To UBound(strNameArray) - 1
    			If strNameArray(i) = strNameArray(j) Then
    				intMark = 0
    			End If
    		Next
    		
    		' If Redundant Unique ID's Exist
    		For j = i + 1 To UBound(strNameArray) - 1
    			If strUniqueList(i) <> "" And strUniqueList(j) <> "" And _ 
    				(strUniqueList(i) <> strUniqueList(j)) Then
    				intMark = 1
    			End If
    		Next
    		
    		' Check for NULL ProcessorID
    		If Trim(strIDArray(i)) = "0000000000000000" Then
    			intMark = 0
    		End If
    		
    					
    		' Calculate Total
    		If intMark = 1 Then
    			intTotal = intTotal + intMark
    		End If		
    	Next
    		
    				
    	' Compare Results
    	If intProc = 2 * intTotal Then
    		GetHTStatus = "True"
    	Else
    		GetHTStatus = "False"
    	End If
    	
    End Function
    
    
    
    ' Get Memory Breakdown
    Function MemoryBreakdown
    	Set colPMAItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray",,48)
    	
    	For Each objPMAItem in colPMAItems
    		lngMax = CLng(objPMAItem.MaxCapacity)
    		intCount = CInt(objPMAItem.MemoryDevices)
    	Next
    	
    	ReDim Preserve strPMArray(intCount)
    	
    	Set colPMItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
    
    	For Each objPMItem in colPMItems
    		strValue = strValue & objPMItem.DeviceLocator & ": "
    		strValue = strValue & objPMItem.Capacity / 2^20 & "MB, "
    		strValue = strValue & objPMItem.Speed & "MHz"
    		
    		strPMArray(TrimTrailingNumber(objPMItem.Tag)) = strValue
    		strValue = ""
    	Next
    	
    	j = 0
    	strResult = ""
    	For j = 0 To intCount - 1
    		If Trim(strPMArray(j)) = "" Then strPMArray(j) = "<Empty>"
    		strResult = strResult & strPMArray(j) & vbcrlf
    	Next
    	
    	strResult = strResult & (lngMax / 2^10) & "MB"
    	
    	MemoryBreakdown = strResult
    End Function
    
    
    
    ' Get Part Name
    Function ExtractPartName(strName)
    	Dim chrRead
    	Dim strRead
    	Dim i
    	
    	For i = 2 To Len(strName)
    		chrRead = Mid(strName, Len(strName) - (i - 1), 1)
    		If chrRead <> Chr(34) Then
    			strRead = chrRead & strRead
    		Else
    			Exit For
    		End If
    	Next
    
    	ExtractPartName = strRead
    End Function
    
    
    
    ' Get Trailing Number
    Function TrimTrailingNumber(strNum)
    
    	Dim chrRead
    	Dim strRead
    	Dim intLen
    	
    	strNum = Trim(strNum)
    	intLen = Len(strNum)
    	
    	i = 1
    	For i = 1 To intLen
    		chrRead = Mid(strNum, intLen - (i - 1), 1)
    		If IsNumeric(chrRead) = "True" Then
    			strRead = chrRead & strRead
    		Else
    			Exit For
    		End If
    	Next
    
    	TrimTrailingNumber = strRead
    End Function
    
    
    
    ' Function: WMIDateStringToDate(dtmDate)
    Function WMIDateToString(dtmDate)
    	WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
        Mid(dtmDate, 7, 2) & "/" & _
        Left(dtmDate, 4) & " " & _
        Mid(dtmDate, 9, 2) & ":" & _
        Mid(dtmDate, 11, 2) & ":" & _
        Mid(dtmDate, 13, 2))
    End Function
    
    
    
    ' Function: GetOsVer
    Function GetOsVer
    	Set colOperatingSystems = objWMIService.ExecQuery _
       		("Select * from Win32_OperatingSystem")
      	For Each objOperatingSystem In colOperatingSystems
        	GetOSVer = CSng(Left(objOperatingSystem.Version, 3))
      	Next
    End Function
    
    
    
    ' Function: GetHPArray
    Function GetHPArray(strComputer2, strUsername2, strPassword2)
    
    	' Check for 64-bit Windows
    	If InStr(PUBOSVer, "x64") Then
    		strCompaq = "Program Files (x86)\Compaq\Cpqacuxe\Bin"
    	Else
    		strCompaq = "Program Files\Compaq\Cpqacuxe\Bin"
    	End If
    		
    
    	' Create Connection Object
    	Set objWMIServiceRem = objWMIService.Get("Win32_Process")	
    						
    	' Confirm Location of Compaq Array Manager
    	Set objHPShell = CreateObject("WScript.Shell")
    	Set objHPFSO = CreateObject("Scripting.FileSystemObject")
    		
    	Set WshNetwork2 = WScript.CreateObject("WScript.Network")
    	WshNetwork2.MapNetworkDrive "", "\\" & strComputer2 & "\C$" ,,strUsername2, strPassword2
    
    	strProgram = "\\" & strComputer2 & "\C$\" & strCompaq & "\cpqacuxe.exe"
    		
    		
    	' Ensure Access is Possible
    	If objHPFSO.FileExists(strProgram) Then
    	
    		' Process Array Config
    		strProcess = Chr(34) & "C:\" & strCompaq & "\cpqacuxe.exe" & Chr(34) & " -c c:\output.txt"
    
    		Process = objWMIServiceRem.Create(strProcess, null, null, intProcessID)
    		
    		
    		' Check for "output.txt"	
    		For intTimerHP = 0 To 10
    			If objFSO.FileExists("\\" & strComputer2 & "\C$\output.txt") Then
    				Exit For 
    			Else
    				WScript.Sleep(1000)
    			End If
    		Next
    				
    		
    		' Process Output		
    		If intTimerHP < 10 Then
    		
    			' Check for Locked Output File
    			Set objHPOutputFile = objHPFSO.GetFile("\\" & strComputer2 & "\C$\output.txt")		
    			
    			If objHPOutputFile.Size <> 0 Then
    			
    				' Close File
    				Set objHPOutputFile = Nothing
    					
    				' Continue Processesing File
    				Set objHPInputFile = objHPFSO.OpenTextFile("\\" & strComputer2 & "\C$\output.txt", ForReading)			
    				
    				Do Until objHPInputFile.AtEndOfStream
    					strHPArray = strHPArray & objHPInputFile.ReadLine & vbcrlf
    				Loop
    						
    															
    				' Close Input File
    				objHPInputFile.Close
    			
    						
    				' Close Link to Server
    				objHPFSO.DeleteFile("\\" & strComputer2 & "\C$\output.txt")
    								
    				Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    				Do While (objGetHPArray.Status = 0)
    					WScript.Sleep(500)
    				Loop
    										
    				' Create String Array
    				strHPParse = Split(strHPArray, vbcrlf)	
    				
    				' Parse For Individual RAID Arrays
    				Dim strArrayList()
    				z = 0
    				
    				For i = 0 To UBound(strHPParse)
    			
    					j = 0
    					' Array and Drives
    					If InStr(strHPParse(i), "Array Specifications") Then
    						
    						ReDim Preserve strArrayList(z)
    						
    						strArrayList(z) = strArrayList(z) & strHPParse(i) & vbcrlf
    								
    						For j = i + 1 To Ubound(strHPParse)
    						 	If InStr(strHPParse(j), "Array Specifications") Then
    						 		Exit For
    							Else
    								strArrayList(z) = strArrayList(z) & strHPParse(j) & vbcrlf
    							End If
    						Next
    			
    						z = z + 1
    					End If
    				Next		
    			
    				
    				' Process Each RAID Array
    				x = 0
    					
    				For x = 0 To UBound(strArrayList)
    				
    					strListParse = Split(strArrayList(x), vbcrlf)
    			
    					For y = 0 To UBound(strListParse)
    				 		
    						' Drives
    						If Left(strListParse(y), 6) = "Drive=" Then
    							strDrives = ""
    							strDrives = Split(strListParse(y), ",")
    																						
    							k = 0
    							For j = 0 To UBound(strDrives)
    								k = k + 1
    							Next
    							
    							strDriveCount = k ' For Output
    						End If
    							
    						
    						' Hot Spare
    						If InStr(strListParse(y), "OnlineSpare=") Then
    							If InStr(strListParse(y), "OnlineSpare= No") Then
    								strHotSpare = strHotSpare & "N" ' For Output
    							Else
    								strHotSpare = strHotSpare & "Y" ' For Output
    							End If	
    						End If
    						
    						
    						' Logical Drives
    						If InStr(strListParse(y), "Logical Drive Specifications") Then
    							
    							' Find First Logical Drive
    							strRAID = Split(strListParse(y + 2), " ")
    							strRAIDResult = strRAIDResult & "RAID " & strRAID(1) & " / " ' For Output
    							strGetDrive = Split(strListParse(y + 3), " ")
    							strRAIDSize = strRAIDSize & ByteConvertRAID(strGetDrive(1)) & " / " ' For Output			
    						End If
    					Next
    					
    					' Process Results
    					strRAIDSize = Left(strRAIDSize, Len(strRAIDSize) - 3)
    					strRAIDResult = Left(strRAIDResult, Len(strRAIDResult) - 3)
    									
    					strNewList = strNewList & strDriveCount & _
    							":" & strRAIDSize & ":" & strRAIDResult & ":" & strHotSpare & Chr(13)
    												
    					' Dispose Array Variables	
    					strDriveCount = ""
    					strRAIDSize = ""
    					strRAIDResult = ""
    					strHotSpare	= "" 		
    				Next
    				
    			
    				' Return Array Output
    				GetHPArray = Left(strNewList, Len(strNewList) - 1)
    				Exit Function
    				
    				
    			Else ' "output.txt" Is Locked
    			
    				' Close File
    				Set objHPOutputFile = Nothing
    				
    				' Kill Remote Connection
    				Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")			
    				Do While (objGetHPArray.Status = 0)
    					WScript.Sleep(500)
    				Loop
    				GetHPArray = ""
    				Exit Function
    			End If
    			
    			
    		Else ' "output.txt" Does not Exist
    			
    			' Kill Remote Connection
    			Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    			Do While (objGetHPArray.Status = 0)
    				WScript.Sleep(500)
    			Loop
    			GetHPArray = ""
    			Exit Function
    		End If
    		
    	
    	Else ' "Array Manager  Does not Exist
    		' Input not Available
    		Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    		Do While (objGetHPArray.Status = 0)
    			WScript.Sleep(500)
    		Loop
    		GetHPArray = ""
    		Exit Function
    	End If
    		
    End Function
    
    '--------------------Functions (End)--------------------'
    
    
    ' Set Excel Attributes
    Const xlVAlignTop = -4160
    Set objRange2 = objWorksheet.UsedRange
    objRange2.VerticalAlignment = xlVAlignTop
    
    ' Set Font Attributes
    objXLA.Cells.Font.Size = 8
    objXLA.Cells.Font.Name = "Arial"
    objXLA.Cells.Font.ColorIndex = 11
    objXLA.Cells.EntireColumn.AutoFit
    objXLA.Cells(1, 9).ColumnWidth = 30 ' RAM Slots
    objXLA.Cells(1, 11).ColumnWidth = 40 ' NIC Port
    objXLA.Cells(1, 13).ColumnWidth = 25 ' Connection Name
    objXLA.Cells(1, 14).ColumnWidth = 25 ' Interface IP's
    objXLA.Cells(1, 15).ColumnWidth = 25 ' Virtual IP's
    objXLA.Cells(1, 16).ColumnWidth = 15 ' DNS1
    objXLA.Cells(1, 17).ColumnWidth = 15 ' DNS2
    objXLA.Cells(1, 18).ColumnWidth = 15 ' Interface Type
    objXLA.Cells.HorizontalAlignment = 2 ' Drive Count
    objXLA.Cells(1, 20).ColumnWidth = 20 ' Virtual IP's
    objXLA.Cells(1, 21).ColumnWidth = 20 ' Virtual IP's
    
    ' Save
    set objFSO2 = CreateObject("Scripting.FileSystemObject")
    strFileName = objFSO2.getAbsolutePathName("") & "\Scan Results.xls"
    objWorkbook.SaveAs(strFileName)
    objWorkbook.Close
    objXLA.Quit
    
    ' Notify User
    WScript.Echo "Process Completed (" & Now & ")"
    
    ' Close Program
    WScript.Quit(0)

    Monday, June 2, 2014 5:52 PM

Answers

  • So, you're asking volunteers to rewrite/fix a 1,200 line script to meet your specifications... (?)

    Surely you can understand why that's a bit presumptuous?

    If you need someone to rewrite/fix code that much code for you, you will likely need to hire a consultant.


    -- Bill Stewart [Bill_Stewart]

    • Proposed as answer by Mike Laughlin Monday, June 2, 2014 6:03 PM
    • Marked as answer by Bill_Stewart Monday, June 30, 2014 6:58 PM
    Monday, June 2, 2014 5:57 PM

All replies

  • I Need my script modified to run this script and output to CSV but its so big I am not sure where to start. I don't need it in XLS at all, and I can add my own headers, cell sizes and colors, etc. so It should just output the data to a simple CSV. 
    ' *******************************
    
    On Error Resume Next
    Dim PUBOSVer ' Global OS Version
    
    ' Open File For Writing
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    Const ForReading = 1
    
    
    ' Get Server List
    strServerFilename = "servers.txt"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(strServerFilename) Then
    	' Open Servers File
    	Set objServers = objFSO.OpenTextFile(strServerFilename, ForReading)
    Else
    	' Server File is missing: Exit
    	intMsg = MsgBox("File: " & Chr(34) & UCASE(strServerFilename) & Chr(34) & _
    				" is either " & _ 
    				"Missing or Damaged!" & vbcrlf & _
    				vbcrlf & _
    				"This Script will now Exit.", vbCritical, "Server File Error")
    	WScript.Quit(0)
    End If
    
    
    Do Until objServers.AtEndOfStream
       	strNewServer = Trim(objServers.ReadLine)
       	strServerList = strServerList & strNewServer & vbcrlf
        intServerCnt = intServerCnt + 1
    Loop
    
    
    ' Enumerate Server Array
    For a = 0 To intServerCnt - 1
    	strServer = Split(strServerList, vbcrlf)
    Next
    
    
    ' ******************************
    	
    ' Create Excel Spreadsheet
    Set objXLA = CreateObject("Excel.Application")
    objXLA.Visible = False
    objXLA.DisplayAlerts = False
    Set objWorkbook = objXLA.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)
    
    'Excel Constants
    Const xlEdgeLeft = 7
    Const xlContinuous = 1
    Const xlNone = -4142
    Const xlMedium = -4138
    Const xlThin = 2
    
    		
    'Set Headers
    ' System Information
    objXLA.Cells(1,1).Value = "Service ID"
    objXLA.Cells(1,2).Value = "Company Name"
    objXLA.Cells(1,3).Value = "Manufacturer"
    objXLA.Cells(1,4).Value = "Model"
    objXLA.Cells(1,5).Value = "Operating System"
    
    ' Processors
    objXLA.Cells(1,6).Value = "Processor Type"
    objXLA.Cells(1,7).Value = "Processors"
    
    ' RAM
    objXLA.Cells(1,8).Value = "RAM"
    objXLA.Cells(1,9).Value = "Slots"
    objXLA.Cells(1,10).Value = "Max Capacity"
    
    ' Network
    objXLA.Cells(1,11).Value = "NIC Port"
    objXLA.Cells(1,12).Value = "Speed"
    objXLA.Cells(1,13).Value = "Connection Name"
    objXLA.Cells(1,14).Value = "Primary IP"
    objXLA.Cells(1,15).Value = "Virtual IP"
    objXLA.Cells(1,16).Value = "Primary DNS"
    objXLA.Cells(1,17).Value = "Secondary DNS"
    
    ' Hard Disks
    objXLA.Cells(1,18).Value = "Interface"
    objXLA.Cells(1,19).Value = "Physical Disks"
    objXLA.Cells(1,20).Value = "Disk Size"
    objXLA.Cells(1,21).Value = "Fault Tolerant"
    objXLA.Cells(1,22).Value = "Hot Spare"
    
    ' Set Top Line
    objXLA.Cells(1, 1).EntireRow.Font.Bold = True
    objXLA.Cells(1, 1).EntireRow.Font.Underline = True
    
    
    ' ******************************
    
    
    For b = 0 To UBound(strServer) - 1
    
    	strServerParts = Split(strServer(b), " ")
    
    	strComputer = strServerParts(0)
    
    	' Parse Server Information 
    	If UBound(strServerParts) = 2 Then
    		strUsername = Trim(strServerParts(1))
    		strPassword = Trim(strServerParts(2))
    	End If
    
    
    	' Create Connection Object
    	Set objWMIService = Nothing
    	Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
    	Set objWMIService = objSWbemLocator.ConnectServer _
    	    (strComputer, "root\cimv2", strUsername, strPassword)
    	objWMIServices.Security_.ImpersonationLevel = 3	
    
    	
    	' Check if Server Exists
    	For intWMICheck = 0 To 15
    		If Not objWMIService Is Nothing Then
    			Exit For
    		Else
    			WScript.Sleep(1000)
    		End If
    	Next
    
    
    	' Server Exists
    	If intWMICheck < 15 Then
    	
    		' Get CPU Information			
    		Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    		
    		For Each colProc In colProcessor
    			strManuf = colProc.Manufacturer
    			strDescription = ProcessorName(colProc.Name)
    			strClockSpeed = colProc.CurrentClockSpeed
    			strSocket = strSocket & colProc.SocketDesignation & vbcrlf
    			strProcID = strProcID & colProc.ProcessorID & vbcrlf
    			strUniqueID = strUniqueID & colProc.UniqueID & vbcrlf
    			ProcCount = ProcCount + 1
    		Next
    		
    		' Determine if Hyperthreading is Enabled
    		strHTStatus = GetHTStatus(strSocket, ProcCount, strProcID, strUniqueID)
    		
    		
    		' DC / HT Results
    		If strHTStatus = "True"	Then
    			If InStr(strManuf, "Intel") Then
    				strDescription = strDescription & " (Dual Core or H/T)"
    			Else
    				strDescription = strDescription & " (Dual Core)"
    			End If
    			
    			ProcCount = ProcCount / 2
    		End If
    		
    				
    		'--------------
    		
    		' Export Information
    		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    		Set colCS = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
    		
    		' Write Basic System Information
    		For Each objItem in colCS
    		
    			Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
    			For Each objItemOS in colOS
    			
    				' Get SP Version
    				If objItemOS.CSDVersion <> "" Then
    					strSPVersion = objItemOS.CSDVersion
    				Else
    					strSPVersion = "No Service Packs Installed"
    				End If
    				
    				If objItemOS.LastBootUpTime <> "" Then
    					strLastBoot = DateConvert(objItemOS.LastBootUpTime)
    				Else
    					strLastBoot = "N/A"
    				End If
    				
    				' Set OS Version Information
    				PUBOSVer = objItemOS.Caption
    			
    				objXLA.Cells(b + 2, 1).Value = objItemOS.csname
    				objXLA.Cells(b + 2, 3).Value = objItem.Manufacturer
    				objXLA.Cells(b + 2, 4).Value = objItem.Model
    				objXLA.Cells(b + 2, 5).Value = PUBOSVer & " - " & strSPVersion
    				objXLA.Cells(b + 2, 6).Value = strDescription
    				objXLA.Cells(b + 2, 7).Value = ProcCount
    				objXLA.Cells(b + 2, 8).Value = MemoryConvert(objItem.TotalPhysicalMemory)				
    			Next
    		Next
    		
    		
    		' Get Memory Breakdown
    		Dim strMemBreak
    		strMemBreak = Split(MemoryBreakdown(), vbcrlf)
    		
    		n = 0
    		For n = 0 To UBound(strMemBreak) - 1
    			strSlots = strSlots & strMemBreak(n) & Chr(10)
    		Next
    		
    		strMaxCapacity = strMemBreak(UBound(strMemBreak))
    		
    		objXLA.Cells(b + 2, 9).Value =  Left(strSlots, Len(strSlots) - 1)
    		objXLA.Cells(b + 2, 10).Value =  strMaxCapacity
    		
    		' Dispose
    		strMemBreak = ""
    		strMaxCapacity = ""
    		strSlots = ""
    		
    		'--------------Computer Information (End)------------------'
    		
    		'-------------Partition Information (Start)----------------'
    		
    				
    		' Get Drive Count
    		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    		Set DiskItemsParent = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
    		intCount = DiskItemsParent.Count
    		
    		' Process Drives
    		intDriveMark = 0
    		For i = 0 To intCount - 1
    			
    			Set DiskItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE Index = " & i)
    			
    			For Each diskItem in DiskItems
    				
    				' Convert Drive Size
    				If diskItem.Size <> "" Then strSize = strSize & ByteConvert(diskItem.Size) & Chr(10) Else strSize = "N/A" & Chr(10)
    				If diskItem.StatusInfo <> "" Then strStsInfo = diskItem.StatusInfo Else strStsInfo = "N/A"
    				If diskItem.SCSIBus <> "" Then strSCSIBus = diskItem.SCSIBus Else strSCSIBus = "N/A"
    				If diskItem.SCSILogicalUnit <> "" Then strSCSILog = diskItem.SCSILogicalUnit Else strSCSILog = "N/A"
    				If diskItem.SCSIPort <> "" Then strSCSIPort = diskItem.SCSIPort Else strSCSIPort = "N/A"
    				If diskItem.SCSITargetId <> "" Then strSCSITarget = diskItem.SCSITargetId Else strSCSITarget = "N/A"
    				
    				
    				' Get Model
    				strModel = Split(diskItem.Model, " ")
    				
    				' Detect HP Array
    				If (UCase(strModel(0)) = "HP" Or UCase(strModel(0)) = "COMPAQ") And intDriveMark = 0 Then
    					strGetHPArray = GetHPArray(strComputer, strUsername, strPassword)
    					
    					If strGetHPArray <> "" Then
    						strSplitHP = Split(strGetHPArray, Chr(13))
    									
    						For a = 0 To UBound(strSplitHP)
    							strSplitResult = Split(strSplitHP(a), ":")
    							i = i + 1
    							
    							strDriveCount = strDriveCount & Trim(strSplitResult(0)) & Chr(10)
    							strDriveSize = strDriveSize & Trim(strSplitResult(1)) & Chr(10)
    							strDriveFault = strDriveFault & Trim(strSplitResult(2)) & Chr(10)
    							strDriveSpare = strDriveSpare & Trim(strSplitResult(3)) & Chr(10)
    							strInterface = strInterface & "HP SCSI" & Chr(10)							
    						Next
    						
    						' Set Controller Output
    						objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    						objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
    						objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    						objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    						
    						intDriveMark = 1 ' Mark That Data was Obtained
    					
    					Else
    					
    						strDriveCount = strDriveCount & "1" & Chr(10)
    						strDriveSize = strDriveSize & strSize & Chr(10)
    						strDriveFault = strDriveFault & "N/A" & Chr(10)
    						strDriveSpare = strDriveSpare & "N/A" & Chr(10)
    						strInterface = strInterface & "HP SCSI " & Chr(10)
    						
    						' Set Controller Output
    						intDriveMark = 1 ' Mark That Another Pass is Invalid
    						
    						' Set Controller Output
    						objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    						objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
    						objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    						objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    					End If
    					
    				Else
    					strDriveCount = strDriveCount & "1" & Chr(10)
    					strDriveSize = strDriveSize & strSize & Chr(10)
    					strDriveFault = strDriveFault & "N/A" & Chr(10)
    					strDriveSpare = strDriveSpare & "N/A" & Chr(10)
    						
    					' Set Controller Output
    					intDriveMark = 1 ' Mark That Another Pass is Invalid
    						
    					' Set Controller Output
    					objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
    					objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))	
    					objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
    					objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
    				
    				
    					' Set Interface
    					If diskItem.InterfaceType = "IDE" Then
    						strInterface = strInterface & "ATA" & Chr(10)						
    					Else
    						strInterface = strInterface & "SATA/SCSI" & Chr(10)
    					End If			
    				End If
    				
    				' Set Cell Value "Interface"
    				objXLA.Cells(b + 2, 18).Value = Left(strInterface, Len(strInterface) - 1)
    			Next
    			
    			' Dispose Drive Sizes
    			strDriveSize = ""
    		Next
    		
    		' Dispose Drive Values
    		strDriveCount = ""
    		strDriveFault = ""
    		strDriveSpare = ""
    		strInterface = ""
    		
    		'----Partition Information (End)---------------------------'
    		
    		
    		
    		'----Network Information (Start)---------------------------'
    		
    	
    		Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
    		
    		i = 1
    		eth = 0
    		Dim STOREDIP(0)
    		intNum = 0
    		
    		For Each objItem in colItems
    		
    			If objItem.NetConnectionStatus <> "" Then
    				
    				' Determine Connection Status
    				If objItem.NetConnectionStatus = 0 Then
    					strNetStat = "Disabled"
    				ElseIf objItem.NetConnectionStatus = 2 Then
    					strNetStat = "Connected"
    				ElseIf objItem.NetConnectionStatus = 7 Then
    					strNetStat = "Disconnected"
    				Else
    					strNetStat = "Unknown"
    				End If
    				
    				If objItem.NetConnectionStatus <> 0 Then
    				
    					' Get Network Card Information
    					Const HKEY_LOCAL_MACHINE = &H80000002
    					strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
    					strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
    					strHostEntry = "Hostname"
    					strDomainEntry = "Domain"
    					strNodeEntry = "DhcpNodeType"
    					strRoutingEntry = "IPEnableRouter"
    		 
    					Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    		 				strComputer & "\root\default:StdRegProv")
    					objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strHostEntry,strHostname
    					objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strDomainEntry,strDomain
    					objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strNodeEntry,dwNodeType
    					objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath1,strRoutingEntry,dwIPRouting
    			 
    					Select Case dwNodeType
    			  			Case 4 strNodeType = "Mixed"
    		  				Case 8 strNodeType = "Hybrid"
    		  				Case Else strNodeType = dwNodeType
    					End Select
    		
    					If dwIPRouting = 0 Then
    		  				strIPRouting = "No"
    					ElseIf dwIPRouting = 1 Then
    			  			strIPRouting = "Yes"
    					Else
    			  			strIPRouting = "?"
    					End If
    		 
    					Set colFirstNicConfig = objWMIService.ExecQuery _
    		 				("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    				
    					For Each objFirstNicConfig In colFirstNicConfig
    		  				strDnsWins = objFirstNicConfig.DNSEnabledForWINSResolution
    					Next
    			
    					Set colNicConfigs = objWMIService.ExecQuery _
    			  			("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    				
    					 
    					' Display per-adapter settings.	
    					For Each objNicConfig In colNicConfigs
    			  			intIndex = objNicConfig.Index
    		 				Set objNic = objWMIService.Get("Win32_NetworkAdapter.DeviceID=" & intIndex)
    		 
    		  				' Connection Name
    		  				If GetOsVer > 5 Then
    		  					' Works only in XP / 2003
    			    			strNetConn = objNic.NetConnectionID				
    		  				ElseIf GetOsVer = 5 Then
    							strNetConn = ""
    		  					' Get Home Drive of Remote Server
    							Set objShell = CreateObject("WScript.Shell")
    							Set objEtherName = objShell.Exec("cmd /c ipconfig | find " & Chr(34) & "Ethernet" & Chr(34))
    						
    							strEtherName = objEtherName.StdOut.ReadAll()					
    							strEtherParse = Split(strEtherName, Chr(13))
    		    				strEtherConn = Split(strEtherParse(eth), " ")
    		    				
    		    				For y = 2 To UBound(strEtherConn)
    		    					strNetConn = strNetConn & " " & strEtherConn(y)
    		    				Next
    		    				
    		    				' Trim Connection Name
    		    				strNetConn = Left(Trim(strNetConn), Len(Trim(strNetConn)) - 1)
    		    			Else
    		    				strNetConn = ""
    						End If
    						
    							 				
    		 				' IP Addresses
    		  				strIPAddresses = ""
    		  			
    		  				If Not IsNull(objNicConfig.IPAddress) Then
    		  	    			For Each strIPAddress In objNicConfig.IPAddress
    		      					strIPAddresses = strIPAddresses & strIPAddress & " "
    		    				Next
    		  				End If
    		  				
    		  				strIPCollection = Split(strIPAddresses, " ")
    		  				    	
    		  				  		
    		  				' Subnets
    						strIPSubnets = ""
    		  
    		  				If Not IsNull(objNicConfig.IPSubnet) Then
    		    				For Each strIPSubnet In objNicConfig.IPSubnet
    			      				strIPSubnets = strIPSubnets & strIPSubnet & " "
    		    				Next
    		  				End If
    		  
    		  				strSMCollection = Split(strIPSubnets, " ")
    		  
    		  				
    		  				' Virtual IP's  	
    		  				strVirtual = ""
    		  				
    		  				If UBound(strIPCollection) > 1 Then
    							For IPCount = 1 To UBound(strIPCollection) - 1
    								strVirtual = strVirtual & (strIPCollection(IPCount) & " / " & strSMCollection(IPCount)) & Chr(10)
    							Next
    							strVirtual = Left(strVirtual, Len(strVirtual) - 1)					
    						End If
    						
    						If Trim(strVirtual) = "" Then strVirtual = "N/A"
    		  
    		  
    		  				' Gateways
    		  				strDefaultIPGateways = ""
    		  				If Not IsNull(objNicConfig.DefaultIPGateway) Then
    		    				For Each strDefaultIPGateway In objNicConfig.DefaultIPGateway
    		      					strDefaultIPGateways = strDefaultIPGateways & strDefaultIPGateway & " "
    			    			Next
    			    		Else
    			    			strDefaultIPGateways = "N/A"
    		  				End If
    		  		
    		  				'--------------------------------------
    		  					
    		  				' If IP is repeated, and was already reported.
    		  				
    		  				intSkipLoop = 0
    		  				If Trim(strNetConn) <> "" Then
    		  					For j = 0 To intNum - 1
    		  						If STOREDIP(j) = strIPAddresses Then
    									intSkipLoop = 1
    		  							Exit For
    		  						End If
    		  					Next
    														
    				  			If intSkipLoop = 0 Then
    								ReDim Preserve STOREDIP(intNum)
    								STOREDIP(intNum) = strIPAddresses	
    								intNum = intNum + 1  				
    			  				End If
    			  			Else
    			  				intSkipLoop = 1
    			  			End If
    			  			
    		  				  
    						' DNS
    		  				strDNSServerSearchOrder = ""
    		  			
    		  				If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
    			    			For Each strDNSServer In objNicConfig.DNSServerSearchOrder
    		      					strDNSServerSearchOrder = strDNSServerSearchOrder & strDNSServer & " "
    		      				Next
    		    				
    		    				strDNS = Split(strDNSServerSearchOrder, " ")
    		    				
    		    				strDNS1 = strDNS(0)
    		    				If Trim(strDNS1) = "" Then strDNS1 = "N/A"
    
    							If UBound(strDNS) > 1 Then
    		    					strDNS2 = strDNS(1)
    							Else
    								strDNS2 = "N/A"
    							End If
    		  				Else
    			  				strDNS1 = "N/A"
    			  				strDNS2 = "N/A"
    		  				End If
    		  				
    						
    						' Run Output Process
    						If intSkipLoop = 0 Then		
    							
    							' Connection Speed
    							strSpeed = "Unknown"
    							
    							Set objWMIService2 = objSWbemLocator.ConnectServer _
    	    						(strComputer, "root\WMI", strUsername, strPassword)
    								objWMIServices.Security_.ImpersonationLevel = 3	
    												
    							Set listAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_LinkSpeed")		
    							Set enumAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_EnumerateAdapter")		
    							
    							For Each objAdapter in listAdapters
    								For Each objEnum in enumAdapters
    									intEnum = Len(objEnum.DeviceName)
    									
    									If objNicConfig.SettingID = Right(objEnum.DeviceName, intEnum - 8) Then
    										If objEnum.InstanceName = objAdapter.InstanceName Then   						
    				    						intLength = Len(objAdapter.NdisLinkSpeed/10000)
    				    						If intLength > 3 Then
    				    							strSpeed = Left(objAdapter.NdisLinkSpeed/10000, intLength - 3)
    				    							strSpeed = strSpeed & ".0 Gbps"
    				    						Else
    				    							strSpeed = objAdapter.NdisLinkSpeed/10000 & " Mbps"
    				    						End If  						
    			    						End If
    			    					End If
    		    					Next
    		   					Next
    
    							strTotalDesc = strTotalDesc & objNicConfig.Description & Chr(10)
    							strTotalSpeed = strTotalSpeed & strSpeed & Chr(10)
    							strTotalNetConn = strTotalNetConn & strNetConn & Chr(10)
    							strPrimaryIP = strPrimaryIP & strIPCollection(0) & " / " & strSMCollection(0) & Chr(10)
    							strDNSTotal1 = strDNSTotal1 & strDNS1 & Chr(10)
    							strDNSTotal2 = strDNSTotal2 & strDNS2 & Chr(10)
    							strTotalVirtual = strTotalVirtual & strVirtual & Chr(10)
    							
    							i = i + 1
    							eth = eth + 2
    							
    							' Dispose
    							strDescription = ""
    							ProcCount = 0
    							strClockSpeed = ""
    							strInterface = ""
    							intCount = 0
    							strSize = ""
    							strSpeed = ""
    							strIPCollection = ""
    							strVirtual = ""
    							strDNS = ""
    							strDNS1 = ""
    							strDNS2 = ""
    		    			End If
    					Next
    					
    					' Output
    					' Trim Leading Chr(10)
    					If Left(strPrimaryIP, 1) = Chr(10) Then strPrimaryIP = Right(strPrimaryIP, Len(strPrimaryIP) - 1)
    					If Left(strTotalVirtual, 1) = Chr(10) Then strTotalVirtual = Right(strTotalVirtual, Len(strTotalVirtual) - 1)
    					If Left(strDNSTotal1, 1) = Chr(10) Then strDNSTotal1 = Right(strDNSTotal1, Len(strDNSTotal1) - 1)
    					If Left(strDNSTotal2, 1) = Chr(10) Then strDNSTotal2 = Right(strDNSTotal2, Len(strDNSTotal2) - 1)
    					
    					objXLA.Cells(b + 2, 11).Value = Trim(Left(strTotalDesc, Len(strTotalDesc) - 1))
    					objXLA.Cells(b + 2, 12).Value = Trim(Left(strTotalSpeed, Len(strTotalSpeed) - 1))
    					objXLA.Cells(b + 2, 13).Value = Trim(Left(strTotalNetConn, Len(strTotalNetConn) - 1))					
    					objXLA.Cells(b + 2, 14).Value = Trim(Left(strPrimaryIP, Len(strPrimaryIP) - 1))
    					objXLA.Cells(b + 2, 15).Value = Trim(Left(strTotalVirtual, Len(strTotalVirtual) - 1))
    					objXLA.Cells(b + 2, 16).Value = Trim(Left(strDNSTotal1, Len(strDNSTotal1) - 1))
    					objXLA.Cells(b + 2, 17).Value = Trim(Left(strDNSTotal2, Len(strDNSTotal2) - 1))
    				End If
    			End If	
    			
    			' Dispose Per Loop
    			strTotalDesc = ""
    			strTotalSpeed = ""
    			strTotalNetConn = ""
    			strPrimaryIP = ""
    			strDNSTotal1 = ""
    			strDNSTotal2 = ""
    			strTotalVirtual	= ""
    			Set eth = 0
    			Set i = 0
    		Next
    		
    		'------------Network Information (End)------------------'
    
    		
    	Else
    		'No Data Present
    		objXLA.Cells(b + 2, 1).Value = strComputer
    		objXLA.Cells(b + 2, 3).Value = "Information Not Available"
    		objXLA.Cells(b + 2, 1).EntireRow.Font.Bold = True
    		objXLA.Cells(b + 2, 1).EntireRow.Interior.ColorIndex = 44
    	End If
    	
    
    	' Dispose Per Server
    	ProcCount = 0
    	strSocket = ""
    	strProcID = ""
    	strUniqueID = ""
    	Set objWMIService = Nothing
    Next
    
    
    
    '-----------------Functions (Start)---------------------'	
    
    ' System Memory Conversion
    Function MemoryConvert(strMem)
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
                            
        If (intLength Mod 4 = 0) Then
            intExp = CInt((intLength / 3) - 2)
        Else
            intExp = CInt((intLength / 3) - 1)
        End If
            
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead) 
                        
        intSize = CLng(strMem / (2 ^ (intExp * (10))))
                            
        If Len(intSize) = 1 Then
         	strFormat = FormatNumber(CStr(intSize), 2)
        Else
          	strFormat = intSize + 1
        End If
                                    
        If (intExp = 1) Then
            strMeasure = "KB"
        ElseIf (intExp = 2) Then
            strMeasure = "MB"
        ElseIf (intExp = 3) Then
            strMeasure = "GB"
        ElseIf (intExp = 4) Then
            strMeasure = "TB"
        ElseIf (intExp = 5) Then
            strMeasure = "PB"
        ElseIf (intExp = 6) Then
            strMeasure = "EB"
        End If
            
        MemoryConvert = strFormat & " " & strMeasure
    End Function
    
    
    
    ' System Byte Conversion
    Function ByteConvert(strMem)
    	
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
        
        If (intLength Mod 3 = 0) Then
            intExp = (intLength / 3) - 1
        Else
            intExp = (intLength / 3)
        End If
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead)                       
        intSize = CLng(strMem / (2 ^ (intExp * (10))))                    
       	strFormat = FormatNumber(CStr(intSize), 2)
                                    
        If (intExp = 1) Then
            strMeasure = "KB"
        ElseIf (intExp = 2) Then
            strMeasure = "MB"
        ElseIf (intExp = 3) Then
            strMeasure = "GB"
        ElseIf (intExp = 4) Then
            strMeasure = "TB"
        ElseIf (intExp = 5) Then
            strMeasure = "PB"
        ElseIf (intExp = 6) Then
            strMeasure = "EB"
        End If
            
        ByteConvert = strFormat & " " & strMeasure
    End Function
    
    
    
    ' System RAID Byte Conversion
    Function ByteConvertRAID(strMem)
    	
    	Dim intLength
        Dim intExp
        Dim intSize
        Dim strSize
        Dim strMeasure
        Dim strMemory
                                 
        intLength = Len(strMem)
        
        If (intLength Mod 3 = 0) Then
            intExp = (intLength / 3) - 1
        Else
            intExp = (intLength / 3)
        End If
        
        ' Convert to Lowest Integer Value
        For intCount = 1 To Len(intExp)
        	chrRead = Mid(intExp, intCount, 1)
        	If chrRead = "." Then
        		Exit For
        	Else
        		strRead = strRead & chrRead
        	End If	
        Next
        
        intExp = Cint(strRead)                       
        intSize = (strMem / (2 ^ (intExp * (10))))                    
       	strFormat = FormatNumber(CStr(intSize), 2)
        
    	If (intExp = 0) Then
            strMeasure = "MB"                                
        ElseIf (intExp = 1) Then
            strMeasure = "GB"
        ElseIf (intExp = 2) Then
            strMeasure = "TB"
        ElseIf (intExp = 3) Then
            strMeasure = "PB"
        ElseIf (intExp = 4) Then
            strMeasure = "EB"
        End If
            
        ByteConvertRAID = strFormat & " " & strMeasure
    End Function
    
    
    
    ' Trim Processor Description
    Function ProcessorName(strName)
    
    	Dim intCounter
    	Dim strRead
    	Dim chrRead, chrReadMore
    	
    	For intCounter = 1 to Len(strName)
    		chrRead = Mid(strName, intCounter, 1)
    		chrReadMore = Mid(strName, intCounter + 1, 1)
    		If ((chrRead <> " ") Or ((chrRead = " ") And (chrReadMore <> " "))) Then
    			strRead = strRead & chrRead
    		End If
    	Next
    	
    	ProcessorName = Trim(strRead)
    End Function
    
    
    
    ' Get Hyper-Threading Status
    Function GetHTStatus(strName, intProc, strID, strUnique)
    	
    	strNameArray = Split(strName, vbcrlf)
    	strIDArray = Split(strID, vbcrlf)
    	strUniqueList = Split(strUnique, vbcrlf)
    	intTotal = 0
    		
    		
    	' Check Socket Designation
    	For i = 0 To UBound(strNameArray) - 1
    		intMark = 1
    		
    		' Check for Redundancies
    		For j = i + 1 To UBound(strNameArray) - 1
    			If strNameArray(i) = strNameArray(j) Then
    				intMark = 0
    			End If
    		Next
    		
    		' If Redundant Unique ID's Exist
    		For j = i + 1 To UBound(strNameArray) - 1
    			If strUniqueList(i) <> "" And strUniqueList(j) <> "" And _ 
    				(strUniqueList(i) <> strUniqueList(j)) Then
    				intMark = 1
    			End If
    		Next
    		
    		' Check for NULL ProcessorID
    		If Trim(strIDArray(i)) = "0000000000000000" Then
    			intMark = 0
    		End If
    		
    					
    		' Calculate Total
    		If intMark = 1 Then
    			intTotal = intTotal + intMark
    		End If		
    	Next
    		
    				
    	' Compare Results
    	If intProc = 2 * intTotal Then
    		GetHTStatus = "True"
    	Else
    		GetHTStatus = "False"
    	End If
    	
    End Function
    
    
    
    ' Get Memory Breakdown
    Function MemoryBreakdown
    	Set colPMAItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray",,48)
    	
    	For Each objPMAItem in colPMAItems
    		lngMax = CLng(objPMAItem.MaxCapacity)
    		intCount = CInt(objPMAItem.MemoryDevices)
    	Next
    	
    	ReDim Preserve strPMArray(intCount)
    	
    	Set colPMItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
    
    	For Each objPMItem in colPMItems
    		strValue = strValue & objPMItem.DeviceLocator & ": "
    		strValue = strValue & objPMItem.Capacity / 2^20 & "MB, "
    		strValue = strValue & objPMItem.Speed & "MHz"
    		
    		strPMArray(TrimTrailingNumber(objPMItem.Tag)) = strValue
    		strValue = ""
    	Next
    	
    	j = 0
    	strResult = ""
    	For j = 0 To intCount - 1
    		If Trim(strPMArray(j)) = "" Then strPMArray(j) = "<Empty>"
    		strResult = strResult & strPMArray(j) & vbcrlf
    	Next
    	
    	strResult = strResult & (lngMax / 2^10) & "MB"
    	
    	MemoryBreakdown = strResult
    End Function
    
    
    
    ' Get Part Name
    Function ExtractPartName(strName)
    	Dim chrRead
    	Dim strRead
    	Dim i
    	
    	For i = 2 To Len(strName)
    		chrRead = Mid(strName, Len(strName) - (i - 1), 1)
    		If chrRead <> Chr(34) Then
    			strRead = chrRead & strRead
    		Else
    			Exit For
    		End If
    	Next
    
    	ExtractPartName = strRead
    End Function
    
    
    
    ' Get Trailing Number
    Function TrimTrailingNumber(strNum)
    
    	Dim chrRead
    	Dim strRead
    	Dim intLen
    	
    	strNum = Trim(strNum)
    	intLen = Len(strNum)
    	
    	i = 1
    	For i = 1 To intLen
    		chrRead = Mid(strNum, intLen - (i - 1), 1)
    		If IsNumeric(chrRead) = "True" Then
    			strRead = chrRead & strRead
    		Else
    			Exit For
    		End If
    	Next
    
    	TrimTrailingNumber = strRead
    End Function
    
    
    
    ' Function: WMIDateStringToDate(dtmDate)
    Function WMIDateToString(dtmDate)
    	WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
        Mid(dtmDate, 7, 2) & "/" & _
        Left(dtmDate, 4) & " " & _
        Mid(dtmDate, 9, 2) & ":" & _
        Mid(dtmDate, 11, 2) & ":" & _
        Mid(dtmDate, 13, 2))
    End Function
    
    
    
    ' Function: GetOsVer
    Function GetOsVer
    	Set colOperatingSystems = objWMIService.ExecQuery _
       		("Select * from Win32_OperatingSystem")
      	For Each objOperatingSystem In colOperatingSystems
        	GetOSVer = CSng(Left(objOperatingSystem.Version, 3))
      	Next
    End Function
    
    
    
    ' Function: GetHPArray
    Function GetHPArray(strComputer2, strUsername2, strPassword2)
    
    	' Check for 64-bit Windows
    	If InStr(PUBOSVer, "x64") Then
    		strCompaq = "Program Files (x86)\Compaq\Cpqacuxe\Bin"
    	Else
    		strCompaq = "Program Files\Compaq\Cpqacuxe\Bin"
    	End If
    		
    
    	' Create Connection Object
    	Set objWMIServiceRem = objWMIService.Get("Win32_Process")	
    						
    	' Confirm Location of Compaq Array Manager
    	Set objHPShell = CreateObject("WScript.Shell")
    	Set objHPFSO = CreateObject("Scripting.FileSystemObject")
    		
    	Set WshNetwork2 = WScript.CreateObject("WScript.Network")
    	WshNetwork2.MapNetworkDrive "", "\\" & strComputer2 & "\C$" ,,strUsername2, strPassword2
    
    	strProgram = "\\" & strComputer2 & "\C$\" & strCompaq & "\cpqacuxe.exe"
    		
    		
    	' Ensure Access is Possible
    	If objHPFSO.FileExists(strProgram) Then
    	
    		' Process Array Config
    		strProcess = Chr(34) & "C:\" & strCompaq & "\cpqacuxe.exe" & Chr(34) & " -c c:\output.txt"
    
    		Process = objWMIServiceRem.Create(strProcess, null, null, intProcessID)
    		
    		
    		' Check for "output.txt"	
    		For intTimerHP = 0 To 10
    			If objFSO.FileExists("\\" & strComputer2 & "\C$\output.txt") Then
    				Exit For 
    			Else
    				WScript.Sleep(1000)
    			End If
    		Next
    				
    		
    		' Process Output		
    		If intTimerHP < 10 Then
    		
    			' Check for Locked Output File
    			Set objHPOutputFile = objHPFSO.GetFile("\\" & strComputer2 & "\C$\output.txt")		
    			
    			If objHPOutputFile.Size <> 0 Then
    			
    				' Close File
    				Set objHPOutputFile = Nothing
    					
    				' Continue Processesing File
    				Set objHPInputFile = objHPFSO.OpenTextFile("\\" & strComputer2 & "\C$\output.txt", ForReading)			
    				
    				Do Until objHPInputFile.AtEndOfStream
    					strHPArray = strHPArray & objHPInputFile.ReadLine & vbcrlf
    				Loop
    						
    															
    				' Close Input File
    				objHPInputFile.Close
    			
    						
    				' Close Link to Server
    				objHPFSO.DeleteFile("\\" & strComputer2 & "\C$\output.txt")
    								
    				Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    				Do While (objGetHPArray.Status = 0)
    					WScript.Sleep(500)
    				Loop
    										
    				' Create String Array
    				strHPParse = Split(strHPArray, vbcrlf)	
    				
    				' Parse For Individual RAID Arrays
    				Dim strArrayList()
    				z = 0
    				
    				For i = 0 To UBound(strHPParse)
    			
    					j = 0
    					' Array and Drives
    					If InStr(strHPParse(i), "Array Specifications") Then
    						
    						ReDim Preserve strArrayList(z)
    						
    						strArrayList(z) = strArrayList(z) & strHPParse(i) & vbcrlf
    								
    						For j = i + 1 To Ubound(strHPParse)
    						 	If InStr(strHPParse(j), "Array Specifications") Then
    						 		Exit For
    							Else
    								strArrayList(z) = strArrayList(z) & strHPParse(j) & vbcrlf
    							End If
    						Next
    			
    						z = z + 1
    					End If
    				Next		
    			
    				
    				' Process Each RAID Array
    				x = 0
    					
    				For x = 0 To UBound(strArrayList)
    				
    					strListParse = Split(strArrayList(x), vbcrlf)
    			
    					For y = 0 To UBound(strListParse)
    				 		
    						' Drives
    						If Left(strListParse(y), 6) = "Drive=" Then
    							strDrives = ""
    							strDrives = Split(strListParse(y), ",")
    																						
    							k = 0
    							For j = 0 To UBound(strDrives)
    								k = k + 1
    							Next
    							
    							strDriveCount = k ' For Output
    						End If
    							
    						
    						' Hot Spare
    						If InStr(strListParse(y), "OnlineSpare=") Then
    							If InStr(strListParse(y), "OnlineSpare= No") Then
    								strHotSpare = strHotSpare & "N" ' For Output
    							Else
    								strHotSpare = strHotSpare & "Y" ' For Output
    							End If	
    						End If
    						
    						
    						' Logical Drives
    						If InStr(strListParse(y), "Logical Drive Specifications") Then
    							
    							' Find First Logical Drive
    							strRAID = Split(strListParse(y + 2), " ")
    							strRAIDResult = strRAIDResult & "RAID " & strRAID(1) & " / " ' For Output
    							strGetDrive = Split(strListParse(y + 3), " ")
    							strRAIDSize = strRAIDSize & ByteConvertRAID(strGetDrive(1)) & " / " ' For Output			
    						End If
    					Next
    					
    					' Process Results
    					strRAIDSize = Left(strRAIDSize, Len(strRAIDSize) - 3)
    					strRAIDResult = Left(strRAIDResult, Len(strRAIDResult) - 3)
    									
    					strNewList = strNewList & strDriveCount & _
    							":" & strRAIDSize & ":" & strRAIDResult & ":" & strHotSpare & Chr(13)
    												
    					' Dispose Array Variables	
    					strDriveCount = ""
    					strRAIDSize = ""
    					strRAIDResult = ""
    					strHotSpare	= "" 		
    				Next
    				
    			
    				' Return Array Output
    				GetHPArray = Left(strNewList, Len(strNewList) - 1)
    				Exit Function
    				
    				
    			Else ' "output.txt" Is Locked
    			
    				' Close File
    				Set objHPOutputFile = Nothing
    				
    				' Kill Remote Connection
    				Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")			
    				Do While (objGetHPArray.Status = 0)
    					WScript.Sleep(500)
    				Loop
    				GetHPArray = ""
    				Exit Function
    			End If
    			
    			
    		Else ' "output.txt" Does not Exist
    			
    			' Kill Remote Connection
    			Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    			Do While (objGetHPArray.Status = 0)
    				WScript.Sleep(500)
    			Loop
    			GetHPArray = ""
    			Exit Function
    		End If
    		
    	
    	Else ' "Array Manager  Does not Exist
    		' Input not Available
    		Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
    		Do While (objGetHPArray.Status = 0)
    			WScript.Sleep(500)
    		Loop
    		GetHPArray = ""
    		Exit Function
    	End If
    		
    End Function
    
    '--------------------Functions (End)--------------------'
    
    
    ' Set Excel Attributes
    Const xlVAlignTop = -4160
    Set objRange2 = objWorksheet.UsedRange
    objRange2.VerticalAlignment = xlVAlignTop
    
    ' Set Font Attributes
    objXLA.Cells.Font.Size = 8
    objXLA.Cells.Font.Name = "Arial"
    objXLA.Cells.Font.ColorIndex = 11
    objXLA.Cells.EntireColumn.AutoFit
    objXLA.Cells(1, 9).ColumnWidth = 30 ' RAM Slots
    objXLA.Cells(1, 11).ColumnWidth = 40 ' NIC Port
    objXLA.Cells(1, 13).ColumnWidth = 25 ' Connection Name
    objXLA.Cells(1, 14).ColumnWidth = 25 ' Interface IP's
    objXLA.Cells(1, 15).ColumnWidth = 25 ' Virtual IP's
    objXLA.Cells(1, 16).ColumnWidth = 15 ' DNS1
    objXLA.Cells(1, 17).ColumnWidth = 15 ' DNS2
    objXLA.Cells(1, 18).ColumnWidth = 15 ' Interface Type
    objXLA.Cells.HorizontalAlignment = 2 ' Drive Count
    objXLA.Cells(1, 20).ColumnWidth = 20 ' Virtual IP's
    objXLA.Cells(1, 21).ColumnWidth = 20 ' Virtual IP's
    
    ' Save
    set objFSO2 = CreateObject("Scripting.FileSystemObject")
    strFileName = objFSO2.getAbsolutePathName("") & "\Scan Results.xls"
    objWorkbook.SaveAs(strFileName)
    objWorkbook.Close
    objXLA.Quit
    
    ' Notify User
    WScript.Echo "Process Completed (" & Now & ")"
    
    ' Close Program
    WScript.Quit(0)

    • Merged by Bill_Stewart Monday, June 2, 2014 6:00 PM Duplicate
    Monday, June 2, 2014 5:55 PM
  • So, you're asking volunteers to rewrite/fix a 1,200 line script to meet your specifications... (?)

    Surely you can understand why that's a bit presumptuous?

    If you need someone to rewrite/fix code that much code for you, you will likely need to hire a consultant.


    -- Bill Stewart [Bill_Stewart]

    • Proposed as answer by Mike Laughlin Monday, June 2, 2014 6:03 PM
    • Marked as answer by Bill_Stewart Monday, June 30, 2014 6:58 PM
    Monday, June 2, 2014 5:57 PM
  • I was going to say that it looks like the OP forgot more than half of the script.

    ¯\_(ツ)_/¯

    Monday, June 2, 2014 7:11 PM
  • To be a bit more serious;  I believe that there are numerous inventory scripts in the Gallery that output to CSV.

    You can also just save the Excel to CSV format by changing one value.


    ¯\_(ツ)_/¯

    Monday, June 2, 2014 7:26 PM
  • objWorkbook.ActiveSheet.SaveAs "c:\temp\sheet1.csv", 6

    ¯\_(ツ)_/¯


    • Edited by jrv Monday, June 2, 2014 7:31 PM
    Monday, June 2, 2014 7:31 PM