Vista - VBscript software inventory

Here is a script I got from Microsoft and modified it.

On Error Resume Next
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"

Const ForReading = 1
'Create FSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Read Text File
Set objFile =
objFSO.OpenTextFile("U:\Scripts\Get_Computer_names\AD_Computers_STMPPG_6_23_08.txt", ForReading)

'*************** Start Excel Format *****************************************
Set objExcel = CreateObject("Excel.Application")
x = 2
objExcel.Visible = True
objExcel.Workbooks.Add
'Adjust Width
objExcel.Columns(1).ColumnWidth = 15 'Username
objExcel.Columns(2).ColumnWidth = 15 'Tech Plate
objExcel.Columns(3).ColumnWidth = 15 'Computer
objExcel.Columns(4).ColumnWidth = 30 'Software Name
objExcel.Columns(5).ColumnWidth = 15 'Install Date
objExcel.Columns(6).ColumnWidth = 15 'Version
objExcel.Columns(7).ColumnWidth = 20 'Estimated Size

Set objRange = objExcel.Worksheets 'Range("A1","G5")
objRange.Font.Size = 14
'Format cells
objExcel.Range("A1:S1").Select
objExcel.Selection.Font.bold = True
objExcel.Selection.Interior.ColorIndex = 4
objExcel.Selection.Interior.Pattern = 1
objExcel.Selection.Font.ColorIndex = 1

'****** Name Headings**********
objExcel.Cells(1, 1).Value = "UserName"
objExcel.Cells(1, 2).Value = "Tech Plate"
objExcel.Cells(1, 3).Value = "Computer Name"
objExcel.Cells(1, 4).Value = "Software Name"
objExcel.Cells(1, 5).Value = "Install Date"
objExcel.Cells(1, 6).Value = "Version"
objExcel.Cells(1, 7).Value = "Estimated Size"

'************** End Excel Format *********************************************

'********************* Start Reading from Text File***************************
Do Until objFile.AtEndOfStream
strcomputer = objFile.ReadLine

'********************** Start ping********************************************
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_PingStatus " & _
"Where Address ='" & strcomputer & "'")
For Each objItem In colItems
If objItem.StatusCode = 0 Then
'WScript.Echo strcomputer & " Reply Received"

'*********************************** Start Script ****************************
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "DefaultUserName"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
Wscript.Echo "UserName: " & strValue
objExcel.Cells(x, 1).Value = strValue

Set objRegistry = GetObject _
("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "System\CurrentControlSet\Services\lanmanserver\parameters"
strValueName = "srvcomment"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName,
strValue
Wscript.Echo "Tech Plate: " & strvalue
objExcel.Cells(x, 2).Value = strvalue

'OS Info
For Each objOS in colOSes
Wscript.Echo "Computer Name: " & objOS.CSName
objExcel.Cells(x, 3).Value = objOS.CSName
Next

Set objReg = GetObject("winmgmts://" & strComputer & _
"/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
'WScript.Echo "Installed Applications" & VbCrLf

For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry1b, strValue1
End If
If strValue1 <> "" Then
'WScript.Echo VbCrLf & "Display Name: " & strValue1
objExcel.Cells(x, 4).Value = strValue1
End If
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry2, strValue2
If strValue2 <> "" Then
'WScript.Echo "Install Date: " & strValue2
objExcel.Cells(x, 5).Value = strValue2
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry3, intValue3
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry4, intValue4
If intValue3 <> "" Then
'WScript.Echo "Version: " & intValue3 & "." & intValue4
objExcel.Cells(x, 6).Value = intValue3 & "." & intValue4
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry5, intValue5
If intValue5 <> "" Then
'WScript.Echo "Estimated Size: " & Round(intValue5/1024, 3) & " megabytes"
'objExcel.Cells(x, 6).Value = intValue3 & "." & intValue4
End If
Next
'******************************************** End Ping
**************************
Else
objExcel.Cells(x, 1).Value = "No Reply"
objExcel.Cells(x, 3).Value = strcomputer
End If
Next

'========================================================
'Add more code here
'========================================================
x = x + 1
Loop

objFile.Close
'Save file
objExcel.ActiveWorkbook.SaveAs
"U:\Scripts\Computer_Inventory\STMPPG_6_23_08.xls"
objExcel.ActiveWorkbook.Close
objExcel.Quit

'*************************End of
Script*******************************************

It open excel and starts writing it like it should. The only problem is that
it write to the same cell for different apps instead of writing one app than
go to the next line and write the next app name. I think the problem is where
I have the x = x + 1

Please help me

"freddy" <freddy@xxxxxx> wrote in message
news:EAE9A7DB-A27F-4EE2-B865-25D4F11B024E@xxxxxxWhen you modify someone else's script then you must ensure that your
modifications are valid. I had a quick look at your script and found a
couple of errors straight away. Here they are:

Line 33 reads
Set objRange = objExcel.Worksheets 'Range("A1","G5")
but it should read
Set objRange = objExcel.Range("A1:G5") 'Range("A1","G5")

Line 85 reads
For Each objOS In colOSes
The variable colOSes is undefined in your script, hence it cannot act as a
"collection".

You may not have noticed these errors because you were suppressing error
reporting right at the start. This is not a good idea. While debugging your
script, you should deactivate all "on error resume next" statements.

I suggest you compare your script with the original and make sure that it
runs without reporting any errors. Perhaps the cell address problem will
then resolve itself.