Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need Help
Below is a script i have that works great it writes to excel, what i need to
do is eliminate all duplicate rows or if they exist dont write to excel again. only if all cells match. as shown below both rows are the same it this case i only want one row if all are the same. Thanks in advance Bob DOMAIN\USERNAME DATE COMPUTERNAME IP ADDRESS WAITING WAITING ROBERT\Administrator 8/3/2006 16:16 XYZ ROBERT\Administrator 8/3/2006 16:19 XYZ ================================================== ==================== Dim objExcel Dim objItem Dim objRange Dim objWorkbook Dim objWorksheet Dim colItems Const HKEY_LOCAL_MACHINE = &H80000002 Set objExcel = CreateObject("Excel.Application") Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls") Set objWorksheet = objWorkbook.Worksheets(1) Set objRange = objWorksheet.Cells(objWorksheet.Rows.Count, 1).End(-4162)(2) Set objRange = objRange.Resize(1, 7) On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_Bus") Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem") Set colDrives = objWMIService.ExecQuery ("Select * From Win32_LogicalDisk Where DriveType = 4") On Error GoTo 0 For Each objComputer in colComputer objRange(1).Value = objComputer.UserName objRange(2).Value = Now Next For Each objDrive in colDrives objRange(3).Value = objDrive.DeviceID & objDrive.ProviderName 'For Each objItem In colItems ' objRange(3).Value = "Bus Number: " & objItem.BusNum ' objRange(4).Value = "Bus Type: " & objItem.BusType ' objRange(5).Value = "Description: " & objItem.Description ' objRange(6).Value = "Device ID: " & objItem.DeviceID ' objRange(7).Value = "Name: " & objItem.Name Set objRange = objRange.Offset(1, 0) Next objRange.EntireColumn.AutoFit '() objExcel.Visible = True objExcel.DisplayAlerts = FALSE objWorkbook.SaveAs("C:\Scripts\Test.xls") WScript.Sleep 15000 objExcel.Quit ================================================== ==================== |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|