Hello Everybody...
Wondered if someone might be able help out with a script I found & edited to produce info on servers in excel..
I've adpated it quite a lot & not yet tidied it up so it's a bit messy but to all intents & purposes it looks ok, except that it seems to go off & scan as it should etc etc but the excel sheet generated never has the info in it, just all the formatting?
Can anyone see what's going on here ? Any help appreciated ?
'*********************************************************************
'Date: 10/05/2005
'Title: XL3.vbs
'Use: Create Server Definitions and dump info to Excel Spreadsheet.
'
'*********************************************************************
'*****[ DECLARATIONS ]************************************************
Const ForReading = 1
Const ForWriting = 2
Const DEV_ID = 0
Const FSYS = 1
Const DSIZE = 2
Const FSPACE = 3
Const USPACE = 4
Const xlAscending = 1
Const xlTopToBottom = 1
Const xlThin = 2
Const xlAutomatic = -4105
Const xlContinuous = 1
Const xlCenter = -4108
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const TITLE = "Server Definitions Script"
Dim fso, fsox, fx, objXL, wmiPath, j
Dim computerIndex, wscr, adsi, intbutton, strStart
Dim inputFile, outputFile, objKill, strAction, strComplete
Dim strPC, intRow, strFilter, RowNum, strCompName
Dim strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed
Dim objExcel, objWorkbook, strComputer, strUser, strPwd
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objXL = CreateObject("Excel.Application")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set WshShell = WScript.CreateObject("WScript.Shell")
myInFile = "Input.xls"
myCur = WshShell.CurrentDirectory
myFol = "ServerDefs"
myInPath = myCur & "\" & myInFile
myOutPath = myCur & "\" & myFol
myOutFile = myOutPath & "\" & "ServerDefs.xls"
inputFile = myInPath
outputFile = myOutPath & "\" & "Servers_Failed_Scan.txt"
'*****[ PATH EXISTENCE CHECKING ]***************************************
If Not FSO.FileExists (myInPath) Then
Wscript.Echo "File : " & myInPath & " Does not Exist.."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "Please Create the File " & myInPath & " To Continue.."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "Script Will Now Exit..."
Wscript.Quit
Else
Wscript.Echo "Input File : " & myInPath & " Found.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Processing.... "
Wscript.Echo " "
Wscript.Echo " "
End If
' Current Path Extraction & Placement
If Not FSO.FolderExists (myOutPath) Then
FSO.CreateFolder (myOutPath)
Wscript.Echo "Folder : " & myOutPath & "\" & " Created..."
Wscript.Echo "Server Definition Spreadsheet Will be Placed here.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Continuing with Collections..."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " Please Wait - This may take some time......."
Wscript.Echo " "
Else
Wscript.Echo "Folder : " & myOutPath & " Already Exists.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Continuing with Collections..."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " Please Wait - This may take some time......."
Wscript.Echo " "
End If
'*****[ SCRIPT BEGINS ]***********************************************
Call KillFile()
set fso = CreateObject("Scripting.FileSystemObject")
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
computerIndex = 1
'*********************************************************************
'*****[ FUNCTIONS ]***************************************************
Call BuildXLS()
Call Connect()
Call Footer()
Call formatter()
objXL.ActiveWorkbook.SaveAs myOutFile
objXL.ActiveWorkbook.Close True
objXL.Quit
Wscript.Echo " Server Def's Complete!"
'*********************************************************************
'*****[ SUB ROUTINES ]************************************************
'*** Subroutine Connect ***
Sub Connect()
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(inputfile)
i = 1
Do until objWorkbook.Sheets("Input").Cells(i,i).Value = ""
strComputer = objWorkbook.Sheets("Input").Cells(i,1).Value
strUser = objWorkbook.Sheets("Input").Cells(i,2).Value
strPwd = objWorkbook.Sheets("Input").Cells(i,3).Value
Wscript.Echo strComputer & vbTab & strUser & vbTab & strPwd
If strUser = "" Then
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2")
Wscript.Echo "Using Main"
Else
Set objWMILocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objWMILocator.ConnectServer(strComputer,"root\cimv2",strUser,strPwd)
Wscript.Echo "Using Alternate"
End If
Call Error()
On Error Resume Next
strCompName = UCase(strComputer)
set BIOSSet = objWMIService.ExecQuery("select SerialNumber from Win32_BIOS")
for each BIOS in BIOSSet
strSN = BIOS.SerialNumber
Next
set MemorySet = objWMIService.ExecQuery("select TotalPhysicalMemory, TotalVirtualMemory, TotalPageFileSpace from Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mbytes"
strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mbytes"
strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mbytes"
Next
set OSSet = objWMIService.ExecQuery("select Caption, CSDVersion, SerialNumber from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
Next
set IPConfigSet = objWMIService.ExecQuery("select ServiceName, IPAddress, IPSubnet, DefaultIPGateway, MACAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
for each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
for each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
set ProSet = objWMIService.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed
Next
Call Disk_C()
Call Disk_D()
Call Disk_E()
i = i + 1
Loop
objExcel.Quit
Set objExcel = Nothing
End Sub
'*** Subroutine Build XLS ***
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = False
objXL.WorkBooks.Add
'** Set Row Height
objXL.Rows(1).RowHeight = 40
'** Set Column widths
objXL.Columns(1).ColumnWidth = 14
objXL.Columns(2).ColumnWidth = 15
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 7
objXL.Columns(5).ColumnWidth = 11
objXL.Columns(6).ColumnWidth = 11
objXL.Columns(7).ColumnWidth = 11
objXL.Columns(8).ColumnWidth = 12
objXL.Columns(9).ColumnWidth = 12
objXL.Columns(10).ColumnWidth = 12
objXL.Columns(11).ColumnWidth = 32
objXL.Columns(12).ColumnWidth = 13
objXL.Columns(13).ColumnWidth = 24
objXL.Columns(14).ColumnWidth = 10
objXL.Columns(15).ColumnWidth = 12
objXL.Columns(16).ColumnWidth = 12
objXL.Columns(17).ColumnWidth = 12
objXL.Columns(18).ColumnWidth = 17
objXL.Columns(19).ColumnWidth = 24
objXL.Columns(20).ColumnWidth = 8
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:T1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.WrapText = True
objXL.Columns("A:T").Select
objXL.Selection.HorizontalAlignment = 2 'xlCenter = 3
objXL.Range("B2").Select
objXL.ActiveWindow.FreezePanes = True
objXL.Columns("A:T").EntireColumn.AutoFit
'*** Set Column Titles ***
Call AddLineToXLS("Server Name","Serial Number","Device ID","File System","Disk Size","Free Space","Used Space","Physical Memory","Virtual Memory","Page File","Operating System","Service Pack","Product ID","Network Card","IP Address","Subnet Mask","Default Gateway","MAC Address","Processor","Speed")
End Sub
Sub formatter()
x = 2
Do Until x = 100
objXL.Rows(x).EntireRow.Interior.ColorIndex = 35
x = x + 1
objXL.Rows(x).EntireRow.Interior.ColorIndex = 0
objXL.Rows(x).Font.Bold = True
x = x + 1
Loop
End Sub
'*** Subroutine Add Lines to XLS ***
Sub AddLineToXLS(strCompName, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed)
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strSN
objXL.Cells(intRow, 3).Value = strDEV_ID
objXL.Cells(intRow, 4).Value = strFSYS
objXL.Cells(intRow, 5).Value = strDSIZE
objXL.Cells(intRow, 6).Value = strFSPACE
objXL.Cells(intRow, 7).Value = strUSPACE
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strVir
objXL.Cells(intRow, 10).Value = strPage
objXL.Cells(intRow, 11).Value = strOS
objXL.Cells(intRow, 12).Value = strSP
objXL.Cells(intRow, 13).Value = strProdID
objXL.Cells(intRow, 14).Value = strNIC
objXL.Cells(intRow, 15).Value = strIP
objXL.Cells(intRow, 16).Value = strMask
objXL.Cells(intRow, 17).Value = strGate
objXL.Cells(intRow, 18).Value = strMAC
objXL.Cells(intRow, 19).Value = strProc
objXL.Cells(intRow, 20).Value = strSpeed
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine Add Lines to XLS for Disk Info. ***
Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)
objXL.Cells(intRow, 3).Value = strDEV_ID
objXL.Cells(intRow, 4).Value = strFSYS
objXL.Cells(intRow, 5).Value = strDSIZE
objXL.Cells(intRow, 6).Value = strFSPACE
objXL.Cells(intRow, 7).Value = strUSPACE
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine to parse C: Partition ***
Sub Disk_C()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'C:' and DriveType = '3'")
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
Call AddLineToXLS(strCompName, strSN, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed)
Next
End Sub
'*** Subroutine to parse D: Partition ***
Sub Disk_D()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'D:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
If IsNull(strDisk(RowNum,FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE))
Next
End Sub
'*** Subroutine to parse E: Partition ***
Sub Disk_E()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'E:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
If IsNull(strDisk(RowNum,FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE))
Next
End Sub
'*** Delete file if exists ***
Sub KillFile()
Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists(myOutFile)) Then
objKill.DeleteFile(myOutFile)
End If
If (objKill.FileExists(outputfile)) Then
objKill.DeleteFile(outputfile)
End If
Set objKill = Nothing
End Sub
'*** Sub to add footer when spreadsheet is complete ***
Sub Footer()
strFooter1 = ""
strFooter2 = ""
strComplete = ""
intRow = intRow + 5
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strFooter1
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strFooter2
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strStart
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strComplete
intRow = intRow + 1
objXL.Columns("A:T").EntireColumn.AutoFit
End Sub
'*** ErrorHandler ***
Sub Error()
On Error Resume Next
set CompSet = objWMIService.ExecQuery("select Name from Win32_ComputerSystem")
If Err Then
fx.WriteLine(strPC)
End If
computerIndex = computerIndex + 1
End Sub
Kind Regards
Al
Keyboard Not Detected.....
Press F1 to Continue.
:}
Wondered if someone might be able help out with a script I found & edited to produce info on servers in excel..
I've adpated it quite a lot & not yet tidied it up so it's a bit messy but to all intents & purposes it looks ok, except that it seems to go off & scan as it should etc etc but the excel sheet generated never has the info in it, just all the formatting?
Can anyone see what's going on here ? Any help appreciated ?
'*********************************************************************
'Date: 10/05/2005
'Title: XL3.vbs
'Use: Create Server Definitions and dump info to Excel Spreadsheet.
'
'*********************************************************************
'*****[ DECLARATIONS ]************************************************
Const ForReading = 1
Const ForWriting = 2
Const DEV_ID = 0
Const FSYS = 1
Const DSIZE = 2
Const FSPACE = 3
Const USPACE = 4
Const xlAscending = 1
Const xlTopToBottom = 1
Const xlThin = 2
Const xlAutomatic = -4105
Const xlContinuous = 1
Const xlCenter = -4108
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const TITLE = "Server Definitions Script"
Dim fso, fsox, fx, objXL, wmiPath, j
Dim computerIndex, wscr, adsi, intbutton, strStart
Dim inputFile, outputFile, objKill, strAction, strComplete
Dim strPC, intRow, strFilter, RowNum, strCompName
Dim strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed
Dim objExcel, objWorkbook, strComputer, strUser, strPwd
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objXL = CreateObject("Excel.Application")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set WshShell = WScript.CreateObject("WScript.Shell")
myInFile = "Input.xls"
myCur = WshShell.CurrentDirectory
myFol = "ServerDefs"
myInPath = myCur & "\" & myInFile
myOutPath = myCur & "\" & myFol
myOutFile = myOutPath & "\" & "ServerDefs.xls"
inputFile = myInPath
outputFile = myOutPath & "\" & "Servers_Failed_Scan.txt"
'*****[ PATH EXISTENCE CHECKING ]***************************************
If Not FSO.FileExists (myInPath) Then
Wscript.Echo "File : " & myInPath & " Does not Exist.."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "Please Create the File " & myInPath & " To Continue.."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "."
Wscript.Echo "Script Will Now Exit..."
Wscript.Quit
Else
Wscript.Echo "Input File : " & myInPath & " Found.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Processing.... "
Wscript.Echo " "
Wscript.Echo " "
End If
' Current Path Extraction & Placement
If Not FSO.FolderExists (myOutPath) Then
FSO.CreateFolder (myOutPath)
Wscript.Echo "Folder : " & myOutPath & "\" & " Created..."
Wscript.Echo "Server Definition Spreadsheet Will be Placed here.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Continuing with Collections..."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " Please Wait - This may take some time......."
Wscript.Echo " "
Else
Wscript.Echo "Folder : " & myOutPath & " Already Exists.."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo "Continuing with Collections..."
Wscript.Echo " "
Wscript.Echo " "
Wscript.Echo " Please Wait - This may take some time......."
Wscript.Echo " "
End If
'*****[ SCRIPT BEGINS ]***********************************************
Call KillFile()
set fso = CreateObject("Scripting.FileSystemObject")
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
computerIndex = 1
'*********************************************************************
'*****[ FUNCTIONS ]***************************************************
Call BuildXLS()
Call Connect()
Call Footer()
Call formatter()
objXL.ActiveWorkbook.SaveAs myOutFile
objXL.ActiveWorkbook.Close True
objXL.Quit
Wscript.Echo " Server Def's Complete!"
'*********************************************************************
'*****[ SUB ROUTINES ]************************************************
'*** Subroutine Connect ***
Sub Connect()
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(inputfile)
i = 1
Do until objWorkbook.Sheets("Input").Cells(i,i).Value = ""
strComputer = objWorkbook.Sheets("Input").Cells(i,1).Value
strUser = objWorkbook.Sheets("Input").Cells(i,2).Value
strPwd = objWorkbook.Sheets("Input").Cells(i,3).Value
Wscript.Echo strComputer & vbTab & strUser & vbTab & strPwd
If strUser = "" Then
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2")
Wscript.Echo "Using Main"
Else
Set objWMILocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objWMILocator.ConnectServer(strComputer,"root\cimv2",strUser,strPwd)
Wscript.Echo "Using Alternate"
End If
Call Error()
On Error Resume Next
strCompName = UCase(strComputer)
set BIOSSet = objWMIService.ExecQuery("select SerialNumber from Win32_BIOS")
for each BIOS in BIOSSet
strSN = BIOS.SerialNumber
Next
set MemorySet = objWMIService.ExecQuery("select TotalPhysicalMemory, TotalVirtualMemory, TotalPageFileSpace from Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mbytes"
strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mbytes"
strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mbytes"
Next
set OSSet = objWMIService.ExecQuery("select Caption, CSDVersion, SerialNumber from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
Next
set IPConfigSet = objWMIService.ExecQuery("select ServiceName, IPAddress, IPSubnet, DefaultIPGateway, MACAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
for each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
for each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
set ProSet = objWMIService.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed
Next
Call Disk_C()
Call Disk_D()
Call Disk_E()
i = i + 1
Loop
objExcel.Quit
Set objExcel = Nothing
End Sub
'*** Subroutine Build XLS ***
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = False
objXL.WorkBooks.Add
'** Set Row Height
objXL.Rows(1).RowHeight = 40
'** Set Column widths
objXL.Columns(1).ColumnWidth = 14
objXL.Columns(2).ColumnWidth = 15
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 7
objXL.Columns(5).ColumnWidth = 11
objXL.Columns(6).ColumnWidth = 11
objXL.Columns(7).ColumnWidth = 11
objXL.Columns(8).ColumnWidth = 12
objXL.Columns(9).ColumnWidth = 12
objXL.Columns(10).ColumnWidth = 12
objXL.Columns(11).ColumnWidth = 32
objXL.Columns(12).ColumnWidth = 13
objXL.Columns(13).ColumnWidth = 24
objXL.Columns(14).ColumnWidth = 10
objXL.Columns(15).ColumnWidth = 12
objXL.Columns(16).ColumnWidth = 12
objXL.Columns(17).ColumnWidth = 12
objXL.Columns(18).ColumnWidth = 17
objXL.Columns(19).ColumnWidth = 24
objXL.Columns(20).ColumnWidth = 8
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:T1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.WrapText = True
objXL.Columns("A:T").Select
objXL.Selection.HorizontalAlignment = 2 'xlCenter = 3
objXL.Range("B2").Select
objXL.ActiveWindow.FreezePanes = True
objXL.Columns("A:T").EntireColumn.AutoFit
'*** Set Column Titles ***
Call AddLineToXLS("Server Name","Serial Number","Device ID","File System","Disk Size","Free Space","Used Space","Physical Memory","Virtual Memory","Page File","Operating System","Service Pack","Product ID","Network Card","IP Address","Subnet Mask","Default Gateway","MAC Address","Processor","Speed")
End Sub
Sub formatter()
x = 2
Do Until x = 100
objXL.Rows(x).EntireRow.Interior.ColorIndex = 35
x = x + 1
objXL.Rows(x).EntireRow.Interior.ColorIndex = 0
objXL.Rows(x).Font.Bold = True
x = x + 1
Loop
End Sub
'*** Subroutine Add Lines to XLS ***
Sub AddLineToXLS(strCompName, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed)
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strSN
objXL.Cells(intRow, 3).Value = strDEV_ID
objXL.Cells(intRow, 4).Value = strFSYS
objXL.Cells(intRow, 5).Value = strDSIZE
objXL.Cells(intRow, 6).Value = strFSPACE
objXL.Cells(intRow, 7).Value = strUSPACE
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strVir
objXL.Cells(intRow, 10).Value = strPage
objXL.Cells(intRow, 11).Value = strOS
objXL.Cells(intRow, 12).Value = strSP
objXL.Cells(intRow, 13).Value = strProdID
objXL.Cells(intRow, 14).Value = strNIC
objXL.Cells(intRow, 15).Value = strIP
objXL.Cells(intRow, 16).Value = strMask
objXL.Cells(intRow, 17).Value = strGate
objXL.Cells(intRow, 18).Value = strMAC
objXL.Cells(intRow, 19).Value = strProc
objXL.Cells(intRow, 20).Value = strSpeed
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine Add Lines to XLS for Disk Info. ***
Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)
objXL.Cells(intRow, 3).Value = strDEV_ID
objXL.Cells(intRow, 4).Value = strFSYS
objXL.Cells(intRow, 5).Value = strDSIZE
objXL.Cells(intRow, 6).Value = strFSPACE
objXL.Cells(intRow, 7).Value = strUSPACE
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine to parse C: Partition ***
Sub Disk_C()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'C:' and DriveType = '3'")
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
Call AddLineToXLS(strCompName, strSN, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed)
Next
End Sub
'*** Subroutine to parse D: Partition ***
Sub Disk_D()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'D:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
If IsNull(strDisk(RowNum,FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE))
Next
End Sub
'*** Subroutine to parse E: Partition ***
Sub Disk_E()
set DiskSet = objWMIService.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'E:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes"
If IsNull(strDisk(RowNum,FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE))
Next
End Sub
'*** Delete file if exists ***
Sub KillFile()
Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists(myOutFile)) Then
objKill.DeleteFile(myOutFile)
End If
If (objKill.FileExists(outputfile)) Then
objKill.DeleteFile(outputfile)
End If
Set objKill = Nothing
End Sub
'*** Sub to add footer when spreadsheet is complete ***
Sub Footer()
strFooter1 = ""
strFooter2 = ""
strComplete = ""
intRow = intRow + 5
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strFooter1
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strFooter2
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strStart
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strComplete
intRow = intRow + 1
objXL.Columns("A:T").EntireColumn.AutoFit
End Sub
'*** ErrorHandler ***
Sub Error()
On Error Resume Next
set CompSet = objWMIService.ExecQuery("select Name from Win32_ComputerSystem")
If Err Then
fx.WriteLine(strPC)
End If
computerIndex = computerIndex + 1
End Sub
Kind Regards
Al
Keyboard Not Detected.....
Press F1 to Continue.
:}
