[kaka999]

ผมรัน vbs แล้วเกิด Error ดังนี้ครับ แต่เป็นแค่บางเครือง ส่วนใหญ่จะรันได้ครับ

Type mismatch: 'oIE.left'
800A000D
Microsoft VBScript runtime error

Error บรรทัดที่ เป็นตัวหนาครับ แนะนำด้วยครับ

Option Explicit
' Global variables we need
Dim objWshell, oIE, oIEDoc

PleaseWait() ' A sort of "Splash Screen" to let the user know we're processing stuff
Dim s : s = GetAddRemove() ' Get the list of installed programs
PleaseWaitOff() ' Gets rid of our little "Splash Screen"
If WriteFile(s) Then ' Write the output file
If MsgBox("Finished processing. Results saved to results.csv" & _
vbcrlf & vbcrlf & "Do you want to view the results now?", 4 + 32, "Installed Programs") = 6 Then
objWshell.Run "excel """ & objWshell.CurrentDirectory & "\results.csv""", 9
End If
End If
Set objWshell = Nothing ' Clean up our leftovers (IE stuff was cleaned up in PleaseWaitOff)

Function PleaseWait()
Dim objWMIService, colItems, objItem, sMsg

' Connect to the Windows Management Instrumentation Service
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")

' This is to initialize the "Please Wait" window
set objWshell = Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"

' Wait for Internet Explorer to initialise before creating a new document
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document

' Because it's an Internet Explorer window, we must get rid of the toolbars etc
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.Document.Body.Scroll = "no"
oIE.document.title = "... - Installed Programs"
oIE.height=130
oIE.width=200

' Execute a query on the WMI to get details of the screen resolution for the primary video card
Set colItems = objWMIService.ExecQuery ("Select * from Win32_VideoController")

For Each objItem in colItems
oIE.left = (objItem.CurrentHorizontalResolution / 2) - 100
oIE.top = (objItem.CurrentVerticalResolution /2) - 65
Exit For 'We only want the primary device.
Next
oIE.Resizable = False
oIE.Visible = True

' This is the message that will be displayed inside this window
sMsg= "<center>Interogating Programs and Versions.<br><marquee>Please wait...</marquee></center>"
oIEDoc.Body.Innerhtml= sMsg
End Function

Function PleaseWaitOff()
' This will close the "Please Wait" window
Set oIEDoc = Nothing
On Error Resume Next ' This catches the error if a user closes the IE window before we've finished.
oIE.Quit
Set oIE = Nothing
End Function

Function GetAddRemove()
Dim cnt, oReg, sBaseKey, iRC, aSubKeys
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

' WMI for Registry Hive
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\./root/default:StdRegProv")
sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys) ' Get all subkeys for uninstallation

Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay

For Each sKey In aSubKeys ' Loop through each App
' Get the Name
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
If iRC <> 0 Then
oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If

'Get the Version
If sValue <> "" Then
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayVersion", sVersion)
If sVersion <> "" Then
sValue = sValue & "," & sVersion
Else
sValue = sValue & ","
End If

' Get the installation date
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "InstallDate", sDateValue)
If sDateValue <> "" Then
sYr = Left(sDateValue, 4)
sMth = Mid(sDateValue, 5, 2)
sDay = Right(sDateValue, 2)
' Some Registry entries have improper date format
On Error Resume Next
sDateValue = DateSerial(sYr, sMth, sDay)
On Error GoTo 0
If sdateValue <> "" Then
sValue = sValue & "," & sDateValue
End If
End If
sTmp = sTmp & sValue & vbcrlf
cnt = cnt + 1
End If
Next

sTmp = BubbleSort(sTmp) ' Sort the list alphabetically.

' Add titles
GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & Now() & _
vbcrlf & vbcrlf & "Program,Version,Installed Date" & vbcrlf & sTmp
End Function

Function BubbleSort(sTmp)
' Simple bubble sort. We're not gonna have enough stuff to warrant a quicksort.
Dim aTmp, i, j, temp

aTmp = Split(sTmp, vbcrlf)
For i = UBound(aTmp) - 1 To 0 Step -1
For j = 0 to i - 1
If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
temp = aTmp(j + 1)
aTmp(j + 1) = aTmp(j)
aTmp(j) = temp
End if
Next
Next
BubbleSort = Join(aTmp, vbcrlf) ' iterate....
End Function

Function WriteFile(sData)
Dim fso, OutFile, bWrite
bWrite = True

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set OutFile = fso.OpenTextFile("results.csv", 2, True, -1)
' We possibly need a prompt to close the file (and one recursion attempt.)
If Err = 70 Then
Wscript.Echo "Could not write to file results.csv, results not saved." & vbcrlf & vbcrlf & _
"This is probably because the file is already open."
bWrite = False
ElseIf Err Then
' Hmm... what's gone wrong?
WScript.Echo err & vbcrlf & err.description
bWrite = False
End If
On Error GoTo 0
If bWrite Then
OutFile.WriteLine(sData)
OutFile.Close
End If

' Clean up our mess
Set fso = Nothing
Set OutFile = Nothing
WriteFile = bWrite
End Function