I have a fantastic VB Script that I found on the web sometime ago. It searches a predetermined list of Windows computers for WMI attributes. It then outputs this list to Excel.
I am no coder but I was able to customize the script to some degree to add additional info. One of the classes I have added was to list features that the server offers. Doing this causes the spreadsheet to add a line for each feature for each server. Generally each server has 10 to 20 features. Therefore for a list of 20 servers, rather than a list of 20 lines, I get a line for each feature for each server. Makes for a very lengthy spreadsheet.
This is an example output for a single server. Multiple this by 20 or 30 for the number of servers.
[TABLE="width: 533"]
<tbody>[TR]
[TD]
[TABLE="class: grid, width: 533"]
<tbody>[TR]
[TD]
[/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]HostName
[/TD]
[TD]Feature Name
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Services
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy and Access Services
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1 Features
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Services
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]ServerName
[/TD]
[TD]Remote Server Administration Tools
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]ServerName
[/TD]
[TD]Group Policy Management
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Controller
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy Server
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Service
[/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP WMI Provider
[/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD]ServerName
[/TD]
[TD]Role Administration Tools
[/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Tools
[/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Certificate Services Tools
[/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server Tools
[/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD]ServerName
[/TD]
[TD]Certification Authority Tools
[/TD]
[/TR]
[TR]
[TD]20
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Snap-Ins and Command-Line Tools
[/TD]
[/TR]
[TR]
[TD]21
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server Tools
[/TD]
[/TR]
[TR]
[TD]22
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS and AD LDS Tools
[/TD]
[/TR]
[TR]
[TD]23
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Administrative Center
[/TD]
[/TR]
[TR]
[TD]24
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory module for Windows PowerShell
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I found a macro that I can run inside Excel that worked great.
Sub olio()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range("B2:B" & lr)
c.Value = c.Value & "(" & c.Offset(0, 1).Value & ")"
Next
For i = lr To 3 Step -1
With sh
If .Cells(i, 1) = .Cells(i - 1, 1) Then
If .Cells(i - 1, 2).Value <> .Cells(i, 2).Value Then
.Cells(i - 1, 2) = .Cells(i - 1, 2).Value & ", " & .Cells(i, 2).Value
.Cells(i - 1, 3) = .Cells(i - 1, 3).Value & ", " & .Cells(i, 3).Value
End If
Rows(i).Delete
End If
End With
Next
End Sub
But I failed to add it to the VBScript that I am running to gather all the info so it happens in one shot. Any insight into how I can add it into the main script would be greatly appreciated.
Below is the VBScript that I am working with.
[TABLE="width: 500"]
<tbody>[TR]
[TD]'**********************************************
'**********************************************
'Date: 04/17/2006
'Title: SMS-PC-Inventory.vbs
'Version: 1.09
'Authors: Clark Caldwell/Alex Angelopoulos/Torgeir Bakken
'Testers: Trey Shaver
'Use: Create network computer inventory in an Excel Spreadsheet.
'Comments:
'Must have ADSI and WMI installed on PC running script.
'
'Must have Excel!
'
'Must have Admin rights on machines you connect to.
'
'If a computer cannot be contacted then it will write that IP to
'PC_Inv_NA.txt outputfile.
'
'Windows XP SP 2 firewall will block this script, enable file/print
'sharing manualy or through a GPO.
'
'Must create the PC_Inv_IP.txt file with the provided script or
'manualy with IP addresses.
'
'Email ccaldwell@dblair.com with problems/sugestions.
'
'***********************************************
'***** DECLARATIONS*****************************
CONST ForReading = 1
CONST ForWriting = 2
CONST DEV_ID = 0
CONST FSYS = 1
CONST DSIZE = 2
CONST FSPACE = 3
CONST USPACE = 4
CONST Feat_ID = 5
CONST Feat_Name = 6
CONST TITLE = "SMS-PC-Inventory"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath, objIEScan, strSN, strOSarch, strRAM2, strFeat_ID, strFeat_Name
'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
inputFile = "PC_Inv_IP.txt" 'List of IP's to scan.
outputFile = "PC_Inv_NA.txt" 'List of IP's that couldn't be scanned.
Call KillFile()
set fso = CreateObject("Scripting.FileSystemObject")
set f = fspenTextFile(inputFile, ForReading, True)
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
'*****[ FUNCTIONS ]*******************************
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
'*****[ MAIN SCRIPT ]*****************************
If Ask("Run Network Inventory?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
Call BuildXLS()
Call Connect()
'Call Footer()
objIEScan.Quit
'objXL.ActiveWorkbook.SaveAs Scriptpath & "SMS-Network-Inventory.xls":
'MsgBox "Your inventory run has completed!", vbInformation + vbOKOnly, TITLE
'*****[ SUB ROUTINES ]****************************
'*** Subroutine Connect ***
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
Call MsgNoPing()
Call Error()
Else
On Error Resume Next
set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
Call MsgNoConnect()
Call Error()
Else
strCompName = UCase(strPC)
' set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_SystemEnclosure")
set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_BIOS")
for each SN in SNSet
strSN = SN.SerialNumber
If strSN = "" Then
strMask = "Blank"
Else
End If
Next
set SDSet = oWMI.ExecQuery("select SocketDesignation from Win32_Processor")
for each SD in SDSet
strSD = SD.SocketDesignation
Next
set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, " & "TotalVirtualMemory, TotalPageFileSpace from " & "Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mb"
strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mb"
strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mb"
Next
'
' set IPAddress = oWMI.ExecQuery("select IPAddress from Win32_NetworkAdapter")
' for each IP in IPAddress
' strIP = IP.IPAddress
'
' Next
set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber, TotalVisibleMemorySize " & "from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
strRAM2 = FormatNumber(OS.TotalVisibleMemorySize/1048576,1) & " GB"
Next
set IPConfigSet = oWMI.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
If strMask = "" Then
strMask = "Blank"
Else
End If
If strGate = "" Then
strGate = "Blank"
Else
End If
Next
set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed & " Hz"
Next
set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
for each Host in HostName
strHostName = Host.DNSHostName
Next
set VideoMem = oWMI.ExecQuery("select AdapterRAM from Win32_VideoController")
for each Video in VideoMem
strVideo = FormatNumber(Video.AdapterRAM/2^20,1) & " Mb"
Next
set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
for each logged in loggeduser
struser = logged.UserName
Next
set FSBSpeed = oWMI.ExecQuery("select ExtClock from Win32_Processor")
for each FSB in FSBSpeed
strFSB = FSB.ExtClock & " Mhz"
Next
set Manufact = oWMI.ExecQuery("select Manufacturer from Win32_BIOS")
for each Man in Manufact
strManufact = Man.Manufacturer
Next
set MBProduct = oWMI.ExecQuery("select Model, SystemType " & "from Win32_ComputerSystem")
for each MBP in MBProduct
strMBProduct = MBP.Model
strOSarch = MBP.SystemType
Next
' set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where DeviceID = 'C:'")
set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where 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) & " Gb"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gb"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gb"
Next
set FeatureSet = oWMI.ExecQuery("select ID, Name " & "from Win32_ServerFeature")
ReDim strFeature(RowNum,6)
for each Feature in FeatureSet
strFeature(RowNum,Feat_ID)= Feature.ID
strFeature(RowNum,Feat_Name)= Feature.Name
' Call AddLineToXLS(strCompName, strHostName, strSN, strOS, strSP, strProdID, strSpeed, strMBProduct, strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strUser,)
' Call AddLineToXLS(strCompName, strHostName, strSN, strManufact, strMBProduct, strOS, strSP, strProc, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strIP, strMask, strGate, strMAC, strRAM2, strOSarch, strFeature(RowNum,Feat_ID), strFeature(RowNum,Feat_Name))
Call AddLineToXLS(strHostName, strFeature(RowNum,Feat_Name), strOS, strSP, strIP, strRAM2, strOSarch, strFeature(RowNum,Feat_ID))
Next
End If
End If
End If
Loop
End Sub
'*** Subroutine Build XLS ***
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Server Features"
'** Set Row Height
objXL.Rows(1).RowHeight = 25
'** Set Column widths
objXL.Columns(1).ColumnWidth = 25
objXL.Columns(2).ColumnWidth = 50
objXL.Columns(3).ColumnWidth = 50
objXL.Columns(4).ColumnWidth = 25
objXL.Columns(5).ColumnWidth = 18
objXL.Columns(6).ColumnWidth = 12
objXL.Columns(7).ColumnWidth = 25
objXL.Columns(8).ColumnWidth = 15
objXL.Columns(9).ColumnWidth = 9
objXL.Columns(10).ColumnWidth = 11
objXL.Columns(11).ColumnWidth = 9
objXL.Columns(12).ColumnWidth = 11
objXL.Columns(13).ColumnWidth = 11
objXL.Columns(14).ColumnWidth = 15
objXL.Columns(15).ColumnWidth = 14
objXL.Columns(16).ColumnWidth = 17
objXL.Columns(17).ColumnWidth = 18
objXL.Columns(18).ColumnWidth = 15
objXL.Columns(19).ColumnWidth = 16
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:H1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 12
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:S").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
'*** Set Column Titles ***
'Call AddLineToXLS ("1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19")
Call AddLineToXLS("HostName","Feature Name","Operating System","Service Pack","IP Address","Memory","OS Architecture","Feature ID")
Set objIESmoke = WScript.CreateObject("InternetExplorer.Application")
objIESmoke.Navigate("about:blank")
objIESmoke.ToolBar = 0
objIESmoke.StatusBar = 0
objIESmoke.Width= 200
objIESmoke.Height = 100
objIESmoke.Left = 400
objIESmoke.Top = 400
Set objDoc = objIESmoke.Document.Body
strHTML = "Smoke'm if you Got'em"
objDoc.InnerHTML = strHTML
objIESmoke.Visible = True
WScript.Sleep 2800
objIESmoke.Quit
Set objIEScan = WScript.CreateObject("InternetExplorer.Application")
objIEScan.Navigate("about:blank")
objIEScan.ToolBar = 0
objIEScan.StatusBar = 0
objIEScan.Width = 200
objIEScan.Height = 100
objIEScan.Left = 400
objIEScan.Top = 400
Set objDoc = objIEScan.Document.Body
strHTML = "Scanning..."
objDoc.InnerHTML = strHTML
objIEScan.Visible = True
End Sub
'*** Subroutine Add Lines to XLS ***
objXL.Columns("A:H").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 12
Sub AddLineToXLS(strHostName, strFeat_Name, strOS, strSP, strIP, strRAM2, strOSarch, strFeat_ID)
' objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 1).Value = strHostName
' objXL.Cells(intRow, 2).Value = strSN
' objXL.Cells(intRow, 3).Value = strManufact
objXL.Cells(intRow, 2).Value = strFeat_Name
' objXL.Cells(intRow, 3).Value = strMBProduct
objXL.Cells(intRow, 3).Value = strOS
objXL.Cells(intRow, 4).Value = strSP
' objXL.Cells(intRow, 4).Value = strProc
' objXL.Cells(intRow, 5).Value = strDEV_ID
' objXL.Cells(intRow, 6).Value = strFSYS
' objXL.Cells(intRow, 7).Value = strDSIZE
objXL.Cells(intRow, 5).Value = strIP
' objXL.Cells(intRow, 8).Value = strMask
' objXL.Cells(intRow, 9).Value = strGate
' objXL.Cells(intRow, 10).Value = strMAC
objXL.Cells(intRow, 6).Value = strRAM2
objXL.Cells(intRow, 7).Value = strOSarch
objXL.Cells(intRow, 8).Value = strFeat_ID
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine Add Lines to XLS for Disk Info. ***
'Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE)
' objXL.Cells(intRow, 8).Value = strDEV_ID
' objXL.Cells(intRow, 9).Value = strFSYS
' objXL.Cells(intRow, 10).Value = strDSIZE
' objXL.Cells(intRow, 11).Value = strFeat_ID
' objXL.Cells(intRow, 12).Value = strFeat_Name
' intRow = intRow + 1
' objXL.Cells(1, 1).Select
'End Sub
'*** Delete file if exists ***
Sub KillFile()
Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists("PC_Inv_NA.txt")) Then
objKill.DeleteFile("PC_Inv_NA.txt")
End If
Set objKill = Nothing
End Sub
'*** Sub to add footer when speadsheet is complete ***
Sub Footer()
strFooter2 = "Script Modified by Mits Matsu****a for Hardware Inventory"
strComplete = "Inventory run completed at: " & Date & " at " & time
intRow = intRow + 2
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strFooter2
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strStart
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strComplete
intRow = intRow + 1
End Sub
'*** ErrorHandler ***
Sub Error()
fx.WriteLine(strPC)
End Sub
'*** Ping Host Timeout ***
Function IsConnectible(sHost, iPings, iTO)
' Returns True or False based on the output from ping.exe
'
' Author: Alex Angelopoulos/Torgeir Bakken
' Works an "all" WSH versions
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
Sub MsgNoPing()
Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.ToolBar = 0
objIE.StatusBar = 0
objIE.Width= 200
objIE.Height = 100
objIE.Left = 400
objIE.Top = 400
Set objDoc = objIE.Document.Body
strHTML = strNoPing
objDoc.InnerHTML = strHTML
objIE.Visible = True
WScript.Sleep 2500
objIE.Quit
End Sub
Sub MsgNoConnect()
Set objIE2 = WScript.CreateObject("InternetExplorer.Application")
objIE2.Navigate("about:blank")
objIE2.ToolBar = 0
objIE2.StatusBar = 0
objIE2.Width= 200
objIE2.Height = 100
objIE2.Left = 400
objIE2.Top = 400
Set objDoc = objIE2.Document.Body
strHTML = strNoConnect
objDoc.InnerHTML = strHTML
objIE2.Visible = True
WScript.Sleep 2500
objIE2.Quit
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]
I am no coder but I was able to customize the script to some degree to add additional info. One of the classes I have added was to list features that the server offers. Doing this causes the spreadsheet to add a line for each feature for each server. Generally each server has 10 to 20 features. Therefore for a list of 20 servers, rather than a list of 20 lines, I get a line for each feature for each server. Makes for a very lengthy spreadsheet.
This is an example output for a single server. Multiple this by 20 or 30 for the number of servers.
[TABLE="width: 533"]
<tbody>[TR]
[TD]
[TABLE="class: grid, width: 533"]
<tbody>[TR]
[TD]
[/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]HostName
[/TD]
[TD]Feature Name
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Services
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy and Access Services
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1 Features
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Services
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]ServerName
[/TD]
[TD]Remote Server Administration Tools
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]ServerName
[/TD]
[TD]Group Policy Management
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Controller
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy Server
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Service
[/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP WMI Provider
[/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD]ServerName
[/TD]
[TD]Role Administration Tools
[/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Tools
[/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Certificate Services Tools
[/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server Tools
[/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD]ServerName
[/TD]
[TD]Certification Authority Tools
[/TD]
[/TR]
[TR]
[TD]20
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Snap-Ins and Command-Line Tools
[/TD]
[/TR]
[TR]
[TD]21
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server Tools
[/TD]
[/TR]
[TR]
[TD]22
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS and AD LDS Tools
[/TD]
[/TR]
[TR]
[TD]23
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Administrative Center
[/TD]
[/TR]
[TR]
[TD]24
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory module for Windows PowerShell
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I found a macro that I can run inside Excel that worked great.
Sub olio()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range("B2:B" & lr)
c.Value = c.Value & "(" & c.Offset(0, 1).Value & ")"
Next
For i = lr To 3 Step -1
With sh
If .Cells(i, 1) = .Cells(i - 1, 1) Then
If .Cells(i - 1, 2).Value <> .Cells(i, 2).Value Then
.Cells(i - 1, 2) = .Cells(i - 1, 2).Value & ", " & .Cells(i, 2).Value
.Cells(i - 1, 3) = .Cells(i - 1, 3).Value & ", " & .Cells(i, 3).Value
End If
Rows(i).Delete
End If
End With
Next
End Sub
But I failed to add it to the VBScript that I am running to gather all the info so it happens in one shot. Any insight into how I can add it into the main script would be greatly appreciated.
Below is the VBScript that I am working with.
[TABLE="width: 500"]
<tbody>[TR]
[TD]'**********************************************
'**********************************************
'Date: 04/17/2006
'Title: SMS-PC-Inventory.vbs
'Version: 1.09
'Authors: Clark Caldwell/Alex Angelopoulos/Torgeir Bakken
'Testers: Trey Shaver
'Use: Create network computer inventory in an Excel Spreadsheet.
'Comments:
'Must have ADSI and WMI installed on PC running script.
'
'Must have Excel!
'
'Must have Admin rights on machines you connect to.
'
'If a computer cannot be contacted then it will write that IP to
'PC_Inv_NA.txt outputfile.
'
'Windows XP SP 2 firewall will block this script, enable file/print
'sharing manualy or through a GPO.
'
'Must create the PC_Inv_IP.txt file with the provided script or
'manualy with IP addresses.
'
'Email ccaldwell@dblair.com with problems/sugestions.
'
'***********************************************
'***** DECLARATIONS*****************************
CONST ForReading = 1
CONST ForWriting = 2
CONST DEV_ID = 0
CONST FSYS = 1
CONST DSIZE = 2
CONST FSPACE = 3
CONST USPACE = 4
CONST Feat_ID = 5
CONST Feat_Name = 6
CONST TITLE = "SMS-PC-Inventory"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath, objIEScan, strSN, strOSarch, strRAM2, strFeat_ID, strFeat_Name
'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
inputFile = "PC_Inv_IP.txt" 'List of IP's to scan.
outputFile = "PC_Inv_NA.txt" 'List of IP's that couldn't be scanned.
Call KillFile()
set fso = CreateObject("Scripting.FileSystemObject")
set f = fspenTextFile(inputFile, ForReading, True)
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
'*****[ FUNCTIONS ]*******************************
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
'*****[ MAIN SCRIPT ]*****************************
If Ask("Run Network Inventory?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
Call BuildXLS()
Call Connect()
'Call Footer()
objIEScan.Quit
'objXL.ActiveWorkbook.SaveAs Scriptpath & "SMS-Network-Inventory.xls":
'MsgBox "Your inventory run has completed!", vbInformation + vbOKOnly, TITLE
'*****[ SUB ROUTINES ]****************************
'*** Subroutine Connect ***
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
Call MsgNoPing()
Call Error()
Else
On Error Resume Next
set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
Call MsgNoConnect()
Call Error()
Else
strCompName = UCase(strPC)
' set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_SystemEnclosure")
set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_BIOS")
for each SN in SNSet
strSN = SN.SerialNumber
If strSN = "" Then
strMask = "Blank"
Else
End If
Next
set SDSet = oWMI.ExecQuery("select SocketDesignation from Win32_Processor")
for each SD in SDSet
strSD = SD.SocketDesignation
Next
set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, " & "TotalVirtualMemory, TotalPageFileSpace from " & "Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mb"
strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mb"
strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mb"
Next
'
' set IPAddress = oWMI.ExecQuery("select IPAddress from Win32_NetworkAdapter")
' for each IP in IPAddress
' strIP = IP.IPAddress
'
' Next
set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber, TotalVisibleMemorySize " & "from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
strRAM2 = FormatNumber(OS.TotalVisibleMemorySize/1048576,1) & " GB"
Next
set IPConfigSet = oWMI.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
If strMask = "" Then
strMask = "Blank"
Else
End If
If strGate = "" Then
strGate = "Blank"
Else
End If
Next
set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed & " Hz"
Next
set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
for each Host in HostName
strHostName = Host.DNSHostName
Next
set VideoMem = oWMI.ExecQuery("select AdapterRAM from Win32_VideoController")
for each Video in VideoMem
strVideo = FormatNumber(Video.AdapterRAM/2^20,1) & " Mb"
Next
set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
for each logged in loggeduser
struser = logged.UserName
Next
set FSBSpeed = oWMI.ExecQuery("select ExtClock from Win32_Processor")
for each FSB in FSBSpeed
strFSB = FSB.ExtClock & " Mhz"
Next
set Manufact = oWMI.ExecQuery("select Manufacturer from Win32_BIOS")
for each Man in Manufact
strManufact = Man.Manufacturer
Next
set MBProduct = oWMI.ExecQuery("select Model, SystemType " & "from Win32_ComputerSystem")
for each MBP in MBProduct
strMBProduct = MBP.Model
strOSarch = MBP.SystemType
Next
' set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where DeviceID = 'C:'")
set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where 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) & " Gb"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gb"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gb"
Next
set FeatureSet = oWMI.ExecQuery("select ID, Name " & "from Win32_ServerFeature")
ReDim strFeature(RowNum,6)
for each Feature in FeatureSet
strFeature(RowNum,Feat_ID)= Feature.ID
strFeature(RowNum,Feat_Name)= Feature.Name
' Call AddLineToXLS(strCompName, strHostName, strSN, strOS, strSP, strProdID, strSpeed, strMBProduct, strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strUser,)
' Call AddLineToXLS(strCompName, strHostName, strSN, strManufact, strMBProduct, strOS, strSP, strProc, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strIP, strMask, strGate, strMAC, strRAM2, strOSarch, strFeature(RowNum,Feat_ID), strFeature(RowNum,Feat_Name))
Call AddLineToXLS(strHostName, strFeature(RowNum,Feat_Name), strOS, strSP, strIP, strRAM2, strOSarch, strFeature(RowNum,Feat_ID))
Next
End If
End If
End If
Loop
End Sub
'*** Subroutine Build XLS ***
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Server Features"
'** Set Row Height
objXL.Rows(1).RowHeight = 25
'** Set Column widths
objXL.Columns(1).ColumnWidth = 25
objXL.Columns(2).ColumnWidth = 50
objXL.Columns(3).ColumnWidth = 50
objXL.Columns(4).ColumnWidth = 25
objXL.Columns(5).ColumnWidth = 18
objXL.Columns(6).ColumnWidth = 12
objXL.Columns(7).ColumnWidth = 25
objXL.Columns(8).ColumnWidth = 15
objXL.Columns(9).ColumnWidth = 9
objXL.Columns(10).ColumnWidth = 11
objXL.Columns(11).ColumnWidth = 9
objXL.Columns(12).ColumnWidth = 11
objXL.Columns(13).ColumnWidth = 11
objXL.Columns(14).ColumnWidth = 15
objXL.Columns(15).ColumnWidth = 14
objXL.Columns(16).ColumnWidth = 17
objXL.Columns(17).ColumnWidth = 18
objXL.Columns(18).ColumnWidth = 15
objXL.Columns(19).ColumnWidth = 16
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:H1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 12
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:S").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
'*** Set Column Titles ***
'Call AddLineToXLS ("1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19")
Call AddLineToXLS("HostName","Feature Name","Operating System","Service Pack","IP Address","Memory","OS Architecture","Feature ID")
Set objIESmoke = WScript.CreateObject("InternetExplorer.Application")
objIESmoke.Navigate("about:blank")
objIESmoke.ToolBar = 0
objIESmoke.StatusBar = 0
objIESmoke.Width= 200
objIESmoke.Height = 100
objIESmoke.Left = 400
objIESmoke.Top = 400
Set objDoc = objIESmoke.Document.Body
strHTML = "Smoke'm if you Got'em"
objDoc.InnerHTML = strHTML
objIESmoke.Visible = True
WScript.Sleep 2800
objIESmoke.Quit
Set objIEScan = WScript.CreateObject("InternetExplorer.Application")
objIEScan.Navigate("about:blank")
objIEScan.ToolBar = 0
objIEScan.StatusBar = 0
objIEScan.Width = 200
objIEScan.Height = 100
objIEScan.Left = 400
objIEScan.Top = 400
Set objDoc = objIEScan.Document.Body
strHTML = "Scanning..."
objDoc.InnerHTML = strHTML
objIEScan.Visible = True
End Sub
'*** Subroutine Add Lines to XLS ***
objXL.Columns("A:H").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 12
Sub AddLineToXLS(strHostName, strFeat_Name, strOS, strSP, strIP, strRAM2, strOSarch, strFeat_ID)
' objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 1).Value = strHostName
' objXL.Cells(intRow, 2).Value = strSN
' objXL.Cells(intRow, 3).Value = strManufact
objXL.Cells(intRow, 2).Value = strFeat_Name
' objXL.Cells(intRow, 3).Value = strMBProduct
objXL.Cells(intRow, 3).Value = strOS
objXL.Cells(intRow, 4).Value = strSP
' objXL.Cells(intRow, 4).Value = strProc
' objXL.Cells(intRow, 5).Value = strDEV_ID
' objXL.Cells(intRow, 6).Value = strFSYS
' objXL.Cells(intRow, 7).Value = strDSIZE
objXL.Cells(intRow, 5).Value = strIP
' objXL.Cells(intRow, 8).Value = strMask
' objXL.Cells(intRow, 9).Value = strGate
' objXL.Cells(intRow, 10).Value = strMAC
objXL.Cells(intRow, 6).Value = strRAM2
objXL.Cells(intRow, 7).Value = strOSarch
objXL.Cells(intRow, 8).Value = strFeat_ID
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine Add Lines to XLS for Disk Info. ***
'Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE)
' objXL.Cells(intRow, 8).Value = strDEV_ID
' objXL.Cells(intRow, 9).Value = strFSYS
' objXL.Cells(intRow, 10).Value = strDSIZE
' objXL.Cells(intRow, 11).Value = strFeat_ID
' objXL.Cells(intRow, 12).Value = strFeat_Name
' intRow = intRow + 1
' objXL.Cells(1, 1).Select
'End Sub
'*** Delete file if exists ***
Sub KillFile()
Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists("PC_Inv_NA.txt")) Then
objKill.DeleteFile("PC_Inv_NA.txt")
End If
Set objKill = Nothing
End Sub
'*** Sub to add footer when speadsheet is complete ***
Sub Footer()
strFooter2 = "Script Modified by Mits Matsu****a for Hardware Inventory"
strComplete = "Inventory run completed at: " & Date & " at " & time
intRow = intRow + 2
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strFooter2
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strStart
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strComplete
intRow = intRow + 1
End Sub
'*** ErrorHandler ***
Sub Error()
fx.WriteLine(strPC)
End Sub
'*** Ping Host Timeout ***
Function IsConnectible(sHost, iPings, iTO)
' Returns True or False based on the output from ping.exe
'
' Author: Alex Angelopoulos/Torgeir Bakken
' Works an "all" WSH versions
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
Sub MsgNoPing()
Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.ToolBar = 0
objIE.StatusBar = 0
objIE.Width= 200
objIE.Height = 100
objIE.Left = 400
objIE.Top = 400
Set objDoc = objIE.Document.Body
strHTML = strNoPing
objDoc.InnerHTML = strHTML
objIE.Visible = True
WScript.Sleep 2500
objIE.Quit
End Sub
Sub MsgNoConnect()
Set objIE2 = WScript.CreateObject("InternetExplorer.Application")
objIE2.Navigate("about:blank")
objIE2.ToolBar = 0
objIE2.StatusBar = 0
objIE2.Width= 200
objIE2.Height = 100
objIE2.Left = 400
objIE2.Top = 400
Set objDoc = objIE2.Document.Body
strHTML = strNoConnect
objDoc.InnerHTML = strHTML
objIE2.Visible = True
WScript.Sleep 2500
objIE2.Quit
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]