Delete Empty Rows

[fsivils]

AppList.xls
	A	B	C	D	E
1	Name	Vendor	Version	InstallDate	InstallLocation
2	MicrosoftAccess97
3
4	AuthorwarePlayer6.5
5
6	CitrixICAClient6.00rev.02.27.02
7
8
9
10
11
12
13
14
15
16
17
18
19	InternetExplorerQ831167
20
21	RoboDemo4.0	eHelpCorporation	4.10.0199	20031029
ASLABPC2

This is a portion of a worksheet that is created by the VBScript below. To use the script, I drag a text document that contains a list of remote computer names over the script's icon (neat, huh?). The script queries the Registry (via WMI), HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall. Unfortunately, not all applications installations create the Subkey, DisplayName, and so there are some blank (empty?) rows in the sheet. I wish to delete these rows on each sheet before moving on the create the next sheet. The code at the end (above the are that saves teh workbook) should do this; however, I constantly receive an error message, to wit, "Unknown runtime error" for line 141 (For k = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1). Does anyone have any ideas?

Thanks.

'Option Explicit
Dim strComputer, strKey, strSubKey, strText
Dim intIndex, intNumApp, MAX_APP
Dim MsgBox_Title
Dim objRegistry
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation
Dim strPublisher, strInstallDate, appCtr

Dim objXL ' Instance of Excel
Dim objDoc ' New Excel document
Dim objArgs ' Script Arguments object
Dim objDictionary ' Script Dictionary
Dim objTextFile ' Object to hold input from the text file
Dim fileName ' Name of the new spreadsheet
Dim Ws ' WScript Shell variable
Dim FSO ' File System Object variable
Dim workDir ' Location of output file

' =====================================================
' Initialize the variables and set the Constant.
'
workDir = "C:\Temp\"
fileName = workDir & "Application List.xls"
HdrCtr = "Current PC Application Inventory"
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Const ForReading = 1
Const HKEY_LOCAL_MACHINE = &H80000002

' =====================================================
' Create the necessary objects. Use Arguments to store input from a
' text file into a Dictionary. This obviates changing the script for
' every computer to be accessed.
'
Set objArgs = WScript.Arguments
Set objDictionary = CreateObject("Scripting.Dictionary")
Set Ws = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(objArgs(0), ForReading)

' =====================================================
' Read the input text file into the Dictionary.
'
i = 0
Do While objTextFile.AtEndOfStream<> True
strNextLine = objTextFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
Ctr = objDictionary.Count

' =====================================================
' Create an instance of MS Excel and make it visible. Use the Add
' method to create a new Workbook.
'
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = True
Set objDoc = objXl.Workbooks.Add

' =====================================================
' Setup the new worksheets; each worksheet name is set to the name of
' the computer being queried. Add Worksheets, as needed, to equal
' the number of items in the Count method of the Dictionary object.
'
If Ctr > 3 Then
For i = 1 To Ctr - 3
objDoc.Sheets.Add
Next
End If

i = 1
appCtr = 0
'On Error Resume Next ' In case the computer is not available

For Each objItem in objDictionary
StrComputer = objDictionary.Item(objItem)
objDoc.Sheets(i).Name = strComputer
With objDoc.Sheets(i).PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
objDoc.Sheets(i).PageSetup.PrintArea = ""
With objDoc.Sheets(i).PageSetup
.CenterHeader = HdrCtr & " for " & strComputer
.RightFooter = "&""Arial,Bold""&9&D"
' .Orientation = xlLandscape
.PrintGridlines = True
End With
With objDoc.Sheets(i)
With .Range("A1:E1").Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
.Range("A1:E1").Font.Bold = True
.Range("A1").Value = "Name"
.Range("B1").Value = "Vendor"
.Range("C1").Value = "Version"
.Range("D1").Value = "Install Date"
.Range("E1").Value = "Install Location"
End With

' =====================================================
' Use WMI to query each computer listed in the new Dictionary. Place
' the information in the spreadsheet. AutoFit ensures that the
' coulmns are correctly sized to see all of the contents.
'
Set objRegistry = GetObject("winmgmts:" & _
"{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")

j = 2
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
For Each strSubKey In arrSubKeys
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "DisplayName", strDisplayName
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "Publisher", strPublisher
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "DisplayVersion", strDisplayVersion
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "InstallDate", strInstallDate
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "InstallLocation", strInstallLocation

With objDoc.Sheets(i)
.Range("A" & j).Value = strDisplayName
.Range("B" & j).Value = strPublisher
.Range("C" & j).Value = strDisplayVersion
.Range("D" & j).Value = strInstallDate
.Range("E" & j).Value = strInstallLocation
.Cells.EntireColumn.AutoFit
End With

appCtr = appCtr + 1
j = j + 1
Next
WScript.Echo "Application Count = " & appCtr

objXL.ScreenUpdating = False
With objDoc.Sheets(i)
For k = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
If .Cells(k, "A").Value = "" Then
.Cells(k, "A").EntireRow.Delete
End If
Next
End With
appCtr = 0
i = i + 1
Next

' =====================================================
' Save the Workbook.
'
'objDoc.SaveAs fileName

 

[Damon Ostrander]

Hi fsivils,

One potential problem with this statement is that your code never declares the variable k. By default it then becomes variant, and in the context of the For loop becomes integer. But the worksheet has 65536 rows, and if there is a value in column A anywhere past row 32767 this will overflow the integer k value. You must have

Dim k As Long

to be able to handle this. I recommend that you use Option Explicit so that any undeclared variables are flagged so that you can explicitly declare them and avoid this type of problem.

And incidentally, .Rows.Count in this statement will always yield 65536, and could be replaced with this literal value (unless some future version of Excel increases the number of rows in a worksheet).

Another possible problem is that the statement assumes that the

With objDoc.Sheets(i)

will qualify a sheet, which is not NECESSARILY a worksheet. If the workbook happens to contain Chart sheets--or even Dialog sheets--and the index i references one of these types of sheets, the For loop will of course fail. You can avoid this potential problem by changing the With to

With objDoc.Worksheets(i)

and you may have to do this throughout your code.

Other than that, the statement looks correct, but if you continue to have problems with it let me know.

 

[fsivils]

Thanks for the advice. I must point out, however, that the expression "As Long" is meaningless in VBScript (in fact, it would generate an error message stating that a Statement was expected). I am not writing a Macro, because the Workbook does not exist until I create it with the script. Thus, I can be reasonably sure that there are no Chart or Dialog sheets in the Workbook. Ideally, I would like to obviate the requirement to delete blank lines; the best way to to that is somehow to skip the recording of Registry entries that do not contain the subkey "DisplayName". However, I cannot conceive of a method to accomplish this end. Just for giggles, use RegEdit to look at your own Registry in the location specified in my submission. You should see the issue to which I allude, to wit: not all applications create the subkey "DisplayName".