consolidate duplicates with vbs

[mipszzz]

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.

A B 1 HostName Feature Name 2 ServerName Active Directory Domain Services 3 ServerName DHCP Server 4 ServerName DNS Server 5 ServerName Network Policy and Access Services 6 ServerName .NET Framework 3.5.1 Features 7 ServerName SNMP Services 8 ServerName Remote Server Administration Tools 9 ServerName Group Policy Management 10 ServerName Active Directory Domain Controller 11 ServerName Network Policy Server 12 ServerName .NET Framework 3.5.1 13 ServerName SNMP Service 14 ServerName SNMP WMI Provider 15 ServerName Role Administration Tools 16 ServerName AD DS Tools 17 ServerName Active Directory Certificate Services Tools 18 ServerName DNS Server Tools 19 ServerName Certification Authority Tools 20 ServerName AD DS Snap-Ins and Command-Line Tools 21 ServerName DHCP Server Tools 22 ServerName AD DS and AD LDS Tools 23 ServerName Active Directory Administrative Center 24 ServerName Active Directory module for Windows PowerShell <tbody> </tbody>

<tbody>
</tbody>

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.

'********************************************** '********************************************** '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

<tbody>
</tbody>