VBScript errors out on one replica machine.. 1

[aiwnjoo]

Hi,

I have the following script that I want to execute as a GPO on users machines however one test machine brings the following error;

Line43
Char2
Error: Invalid procedure call or argument
Code: 800A0005

Here is the script, no idea why its doing it. The test machine is an exact replica of my other successful test machines.

col1=Array("ProductName","YES")
col2=Array("ProductVendor","YES")
col3=Array("ProductVersion","YES")
col4=Array("InstallDate","YES")
col5=Array("ComputerName", "YES")
col6=Array("UserName", "YES")

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")

strComputer = WshNetwork.ComputerName
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )

Set fileObj = CreateObject("Scripting.FileSystemObject")

If fileObj.FileExists("\\fa-dc01\Installers\Test\" & strComputer & " - " & strUserName & ".csv") Then
WScript.Quit
Else
Set csvFile = fileObj.CreateTextFile("\\fa-dc01\Installers\Test\" & strComputer & " - " & strUserName & ".csv")
End If

Set WMIObject = GetObject("winmgmts:\\.\root\cimv2")
Set resultSet = WMIObject.ExecQuery ("SELECT * FROM Win32_Product")

'Msgbox "The export will now begin, it may take a few seconds!",vbokonly,"Message"

if(col1(1)="YES") then header=header & col1(0) & "," end if
if(col2(1)="YES") then header=header & col2(0) & "," end if
if(col3(1)="YES") then header=header & col3(0) & "," end if
if(col4(1)="YES") then header=header & col4(0) & "," end if
if(col5(1)="YES") then header=header & col5(0) & "," end if
if(col6(1)="YES") then header=header & col6(0) & "," end if
csvFile.WriteLine mid(header,1,len(header)-1)

For Each app in resultSet
if(col1(1)="YES") then rowData=rowData & """" & app.Name & """" & "," end if
if(col2(1)="YES") then rowData=rowData & """" & app.Vendor & """" & "," end if
if(col3(1)="YES") then rowData=rowData & """" & app.Version & """" & "," end if
if(col4(1)="YES") then rowData=rowData & """" & app.InstallDate & """" & "," end if
if(col5(1)="YES") then rowData=rowData & """" & strComputer & """" & "," end if
if(col6(1)="YES") then rowData=rowData & """" & strUserName & """" & "," end if
csvFile.WriteLine mid(rowData,1,len(rowData)-1)

rowData=""

Next

'Msgbox "Data exported successfully, see generated .csv file",vbokonly,"Done"

csvFile.Close

Thanks

 

[strongm]

You probably want to ask this in forum329 rather than here, since this is the VB5/6 forum.

 

[fredericofonseca]

wrong forum - but issue is that for some reason your machine is not exactly like the others and one of the apps being returned has characters that are invalid for a writeline operation.

you can check this by displaying the contents before writting - you will see some ? marks where you have invalid chars

WScript.Echo mid(rowData,1,len(rowData)-1)
csvFile.WriteLine mid(rowData,1,len(rowData)-1)


see revised script below using a stream instead

col1=Array("ProductName","YES")
col2=Array("ProductVendor","YES")
col3=Array("ProductVersion","YES")
col4=Array("InstallDate","YES")
col5=Array("ComputerName", "YES")
col6=Array("UserName", "YES")

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")

strComputer = WshNetwork.ComputerName
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Dim filename = "\\fa-dc01\Installers\Test\" & strComputer & " - " & strUserName & ".csv"
'filename = "c:\temp\x\" & strComputer & " - " & strUserName & ".csv"

Set fileObj = CreateObject("Scripting.FileSystemObject")

If fileObj.FileExists(filename) Then
WScript.Quit
End If

Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = 2
BinaryStream.Open

Set WMIObject = GetObject("winmgmts:\\.\root\cimv2")
Set resultSet = WMIObject.ExecQuery ("SELECT * FROM Win32_Product")

'Msgbox "The export will now begin, it may take a few seconds!",vbokonly,"Message"

if(col1(1)="YES") then header=header & col1(0) & "," end if
if(col2(1)="YES") then header=header & col2(0) & "," end if
if(col3(1)="YES") then header=header & col3(0) & "," end if
if(col4(1)="YES") then header=header & col4(0) & "," end if
if(col5(1)="YES") then header=header & col5(0) & "," end if
if(col6(1)="YES") then header=header & col6(0) & "," end if
BinaryStream.WriteText mid(header,1,len(header)-1) & vbCrLf 

For Each app in resultSet
if(col1(1)="YES") then rowData=rowData & """" & app.Name & """" & "," end if
if(col2(1)="YES") then rowData=rowData & """" & app.Vendor & """" & "," end if
if(col3(1)="YES") then rowData=rowData & """" & app.Version & """" & "," end if
if(col4(1)="YES") then rowData=rowData & """" & app.InstallDate & """" & "," end if
if(col5(1)="YES") then rowData=rowData & """" & strComputer & """" & "," end if
if(col6(1)="YES") then rowData=rowData & """" & strUserName & """" & "," end if
BinaryStream.WriteText mid(rowData,1,len(rowData)-1) & vbCrLf 

rowData=""

Next

BinaryStream.SaveToFile filename, 2
'Msgbox "Data exported successfully, see generated .csv file",vbokonly,"Done"

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

FAQ219-2884
FAQ181-2886

 

[aiwnjoo]

Hi, thanks very much for this however on line 14 - Expected end of statement error?

EDIT: Removed Dim and it worked but the result goes into one column now instead of several columns once it writes. Can this be fixed?

 

[strongm]

BTW, Microsoft tend to advise against the sue of Win32_Product to enumerate installed applications, since:

a) It only shows applications installed via the Microsoft Installer, MSI (and not all applications use that)
b) It has some additional side-effects (it actually performs an Installer “reconfiguration” on every MSI package on the system as its performing the query, ref:

https://support.microsoft.com/en-us/kb/974524)

c) a side-effect of the side-effects is that the enumeration is really slow

An alternative would be to enumerate the keys under HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall using WMI's registry provider.

 

[aiwnjoo]

Thanks although our organisation only uses Microsoft installer so should be ok however will look into that.

Any suggestion on the error I posted? Thanks

 

[fredericofonseca]

Sorry about the dim - had made that error myself and only corrected my test line and not your own.

Output - thats weird - on my test the file is a proper csv and when opening in Excel it does show each value on its own column.

(and I forgot to mention before - you really should consider changing to use Powershell for this stuff as it will give you a lot more flexibility going forward - see an example of doing this same task at

https://blogs.technet.microsoft.com...owershell-to-quickly-find-installed-software/

output would need to be adjusted to your needs)

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

FAQ219-2884
FAQ181-2886

 

[strongm]

Suggestion? I thought you'd already fixed it by removing the Dim. Or are you talking about the columns?

 

[aiwnjoo]

Thanks again, the output in Excel 2013 is showing all results in column a with a , separating them instead of in columns.

I would have used C++ however this seems easier running through a GPO.

Thanks.

 

[aiwnjoo]

Bump. Thankyou

 

[SkipVought]

In Excel you can use the Text to Columns feature, delimiting via COMMA.

In Script, set an Excel object and so perform.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[strongm]

Please don't bump in these forums. You'll simply alienate the people who might have been willing to help you.

 

[aiwnjoo]

Sorry about the bump, I have managed to change it so the result prints to HTML. Here is the polished version if anyone finds it useful.

Not sure how clean it is, if I have missed anything or if anyone has any suggestions please feel free

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")

strComputer = WshNetwork.ComputerName
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
filename = "\\fa-dc01\Installers\Test\" & strComputer & " - " & strUserName & ".html"

Set fileObj = CreateObject("Scripting.FileSystemObject")

If fileObj.FileExists(filename) Then
WScript.Quit
End If

Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = 2
BinaryStream.Open

Set WMIObject = GetObject("winmgmts:\\.\root\cimv2")
Set resultSet = WMIObject.ExecQuery ("SELECT * FROM Win32_Product")

BinaryStream.WriteText "<HTML>"
BinaryStream.WriteText "    <body bgcolor='#FFFFFF' text='#000000' link='#0000FF' vlink='000099' alink='#00FF00'>"
BinaryStream.WriteText "        <center>"
BinaryStream.WriteText "            <h1>System Information for " & strComputer & " - " & strUserName & "</h1>"
BinaryStream.WriteText "        </center>"

BinaryStream.WriteText "<TR><TD colspan='2' bgcolor='#f0f0f0'></TD></TR>"
BinaryStream.WriteText "<TABLE width='100%' cellspacing='0' cellpadding='2' border='1' bordercolor='#c0c0c0' bordercolordark='#ffffff' bordercolorlight='#c0c0c0'>"
BinaryStream.WriteText "<TR height=2><TD height=10 align=center bgcolor=midnightblue colspan=4></TD></TR>"
BinaryStream.WriteText "<TR><TD width=30% align=center bgcolor='#e0e0e0'><b>Name</b></td><td width=30% align=center bgcolor='#e0e0e0'><b>Vendor</b></td><td width=30% align=center bgcolor='#e0e0e0'><b>Version</b></td><td width=30% align=center bgcolor='#e0e0e0'><b>Install Date</b></TD></TR>"
For Each app In resultSet
BinaryStream.WriteText "<TR><TD align=center bgcolor=#f0f0f0>" & app.Name & "</td><td align=center bgcolor=#f0f0f0>" & app.Vendor & "</td><td align=center bgcolor=#f0f0f0>" & app.Version & "</td><td align=center bgcolor=#f0f0f0>" & app.InstallDate & "</TD></TR>"
Next

BinaryStream.WriteText "<TR height=2><TD height=10 align=center bgcolor=midnightblue colspan=4></TD></TR>"
BinaryStream.WriteText "</TABLE>"
BinaryStream.WriteText "</TD></TR>"
BinaryStream.WriteText "<P><small></small></P>"
BinaryStream.WriteText "</BODY>"
BinaryStream.WriteText "<HTML>"

BinaryStream.SaveToFile filename, 2

Thanks all.