VBScript not running depending on the web server - vbscript

I've a very strange problem with a VBScript: it works fine depending on the server where the web is located.
I have the same web application on two servers with IIS 7.5. In each server, the code is exactly the same.
The VBScript executes some Excel lines and it updates some information at the web application. The problem comes when updating this information. In one of the servers, there's no problem, but in the other, I get the error below:
As the script runs as it would do, I guess there's no syntax error
The code throwing the error is:
With objIE
If (testing) Then
.Navigate URLtesting
Else
.Navigate URL
WScript.Sleep 2000
End If
WaitWebLoad()
.document.getElementById(user).Value = userScript
.document.getElementById(password).Value = passwordScript
.document.getElementById(logInButton).Click()
WaitWebLoad()
.document.getElementByID(loretoLink).Click()
WaitWebLoad()
.document.getElementByID(updatePLLink).Click()
WaitWebLoad()
Do
lastRow = activeSheet.Cells(rowIndex, columnPL_ID).Value
dateAssociated = activeSheet.Cells(rowIndex, columnArrivalDate).Value
concesion = activeSheet.Cells(rowIndex, columnConcesion).Value
If lastRow <> "" Then
.document.getElementByID(searchPL_TB).Value = lastRow
.document.getElementByID(searchPL_Button).Click()
WaitWebLoad()
If (Not (.document.getElementByID(errorLookingPL)) Is Nothing Or Not (.document.getElementByID(noSearchResult) Is Nothing)) Then
'PL not found
recordsNotFound = recordsNotFound + 1
WriteOpenFileText(logFilePath), (Now & vbTab & "***PL not found: " & lastRow & " - [" & dateAssociated & "]" & " - " & concesion & vbCrLf)
Else ...
The line number 295 is:
If (Not (.document.getElementByID(errorLookingPL)) is Nothing Or Not (.document.getElementByID(noSearchResult) is Nothing)) Then
The WaitWebLoad function code is:
Function WaitWebLoad()
Dim timer
timer = 0
With objIE
Do While .Busy
If timer < timerWebLoad Then
WScript.Sleep 100
timer = 100
Else
'Error loading the web
objExcel.Workbooks.close
objExcel.quit
objIE.quit
DeleteFile(pathTemp)
endScriptStamp = Now
WScript.Echo("Error." & vbCrLf & "Total runtime is: " & DateDiff("s", startScriptStamp, endScriptStamp) & " seconds.")
WScript.quit
End If
Loop
End With
End Function
I guess the problem is that the script, when running the server where the error takes place, is losing the objIE object, but I don't know why it's becoming lost only in one of the servers.

The getElementById method returns the first object with the same ID attribute as the specified value, or null if the id cannot be found. Reference: .NET Framework and Document Object Model (DOM).
On the other side, Is operator compares two object reference variables and Null is not an object; it indicates that a variable contains no valid data.
Moreover, if used in VBScript, getElementById method could raise 800A01A8 (=decimal -2146827864) Microsoft VBScript runtime error: Object required if used improperly: for instance, as you can't write Set objAny = Null!
Here's a workaround:
On Error Resume Next ' enable error handling
Set oerrorLookingPL = .document.getElementByID(errorLookingPL) ' try
If Err.Number <> 0 Then Set oerrorLookingPL = Nothing ' an error occurred?
Err.Clear
If Vartype(oerrorLookingPL) = 1 Then Set oerrorLookingPL = Nothing ' Null => Nothing
Set onoSearchResult = .document.getElementByID(noSearchResult)
If Err.Number <> 0 Then Set onoSearchResult = Nothing
Err.Clear
If Vartype(onoSearchResult) = 1 Then Set onoSearchResult = Nothing
On Error Goto 0 ' disable error handling
If (Not (oerrorLookingPL Is Nothing) Or Not (onoSearchResult Is Nothing)) Then
I can't recommend global use of On Error Resume Next as If condition Then … statement always evaluates given condition to True if a runtime error occurs while evaluating it, see next example:
On Error Resume Next
' show Variant subtype information about Null and Nothing
Wscript.Echo VarType(Null) & " Null " & TypeName(Null)
Wscript.Echo VarType(Nothing) & " Nothing " & TypeName(Nothing)
' all conditions as well as their negations are evaluated to `True`
if (Null = Nothing) then Wscript.Echo " Null = Nothing"
if NOT (Null = Nothing) then Wscript.Echo "not (Null = Nothing)"
if (Null is Nothing) then Wscript.Echo " Null is Nothing"
if NOT (Null is Nothing) then Wscript.Echo "not (Null is Nothing)"
' show runtime error
On Error GoTo 0
if (Null is Nothing) then Wscript.Echo " Null is Nothing"
Both Null = Nothing and Null is Nothing conditions are evaluated to True as well as their negations!
==> cscript D:\VB_scripts\SO\37563820.vbs
1 Null Null
9 Nothing Nothing
Null = Nothing
not (Null = Nothing)
Null is Nothing
NOT (Null is Nothing)
==> D:\VB_scripts\SO\37563820.vbs(12, 1) Microsoft VBScript runtime error: Object required

Related

Scriptcontrol object returns recordset object

I am creating a library using vbscript and using scriptcontrol object to call these routines from vba. I am trying to create a recordset as a routine with the given sql as parameter as below
sub GetData(sql, byref retrst)
stADO = "Provider=SQLOLEDB.1;Persist Security Info=False;Initial
Catalog=CCMSProd;Data Source=sv-hfi-ccms;UID=vc;PWD=dw;"
cnconn as adoconnection
Set cnconn = CreateObject("ADODB.Connection")
cnconn.Open stADO
msgbox cnconn.ConnectionString
msgbox cnconn.state
With cnconn
.CommandTimeout = 0
Set retrst = .Execute(sql)
msgbox retrst.recordcount
End With
cnconn.close
end sub
and calling this routine as below
scr.Run "GetConnection", tempload, rst
but my recordset returns as nothing, eventhough the connection and recordset created within vbscript.
I need help in this.
There are quite a few problems with your script. I'm not going to go in to each one but be aware that the recordset open call has more parameters. They aren't required but the defaults are adForwardOnly for the cursor type, and adLockReadOnly for locking. Using the defaults will not enable you to get a record count from the recordset so the code I provide just shows the value of the first record in the recordset to indicate data was retrieved.
https://support.microsoft.com/en-us/help/272067/how-to-get-a-record-count-from-a-sql-server-ce-recordset
The code below works but you'll need to modify it for your usage.
Batch file to run the script:
GetRecordset.bat
cscript.exe /nologo GetRecordset.vbs
pause
Script to run:
GetRecordset.vbs
Dim objADORecordset
Dim strDBTableName
On Error Resume Next
'*****Modify below to a table name in your database*****
strDBTableName = "SomeDBTableName"
Set objADORecordset = CreateObject("ADODB.Recordset")
If Err.Number = 0 Then
GetRecordset "SELECT * FROM " & strDBTableName, objADORecordset
With objADORecordset
If Not .BOF Then
.MoveFirst
WScript.Echo "Field 0: " & .Fields(0).Value
Else
WScript.Echo "No records in recordset"
End If
End With
Else
WScript.Echo "Unable to create ADO Recordset"
End If
set objADORecordset = Nothing
WScript.Quit
'*********************************************
Sub GetRecordset(astrSQLQuery, aobjRecordset)
Dim strOLEConnect
Dim strUserID
Dim strUserPW
Dim objADOConnection
On Error Resume Next
WScript.Echo "SQLQuery: " & astrSQLQuery
strOLEConnect = "Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=CCMSProd;Data Source=sv-hfi-ccms;UID=vc;PWD=dw;"
strUserID = "vc"
strUserPW = "dw"
Set objADOConnection = CreateObject("ADODB.Connection")
If Err.Number = 0 Then
objADOConnection.Open strOLEConnect, strUserID, strUserPW
If Err.Number = 0 Then
aobjRecordset.Open astrSQLQuery, objADOConnection
If Err.Number <> 0 Then
WScript.Echo "Recordset open failed ERROR=" & Err.Number
End If
Else
WScript.Echo "Connection open failed ERROR=" & Err.Number
End If
Else
WScript.Echo "ADO connection failed ERROR=" & Err.Number
End If
Set objADOConnection = Nothing
End Sub
I left it similar to your code so you can understand it but it should really create and open the ADO connection before the ADORecordset. You would typically open the connection, run all of the required queries and process them before closing the connection. There's no sense in creating a new connection to the same database multiple times for different queries to the same database. It just adds unnecessary overhead. I'll leave it to you to improve the code for your use.

VBS Object required error, 800A01A8

Hello I'm trying to debug this script that I inherited below. The error is on line 71 char 6. Object required 'oFile'
I don't have any vbs experience so please be gentle. This script takes a scan and uploads it to a doc archive server, gives it unique filename etc. I haven't figured out what 'ofile' is yet :/
'Feb 18, 2005
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
hiddenCount = 0
'Wscript.Echo Wscript.Arguments(0)
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set scanFiles = oFSO.GetFolder(Wscript.Arguments(0)).Files
For Each oFile In scanFiles
If oFile.Attributes and 2 Then
hiddenCount = hiddenCount + 1
End If
Next
Else
Set scanFiles = WScript.Arguments
End If
fileCount = scanFiles.Count - hiddenCount
'Wscript.Echo hiddenCount
'WScript.Echo fileCount
'WScript.Quit()
Set oIE = WScript.CreateObject("InternetExplorer.Application")
oIE.left=50 ' window position
oIE.top = 100 ' and other properties
oIE.height = 300
oIE.width = 350
oIE.menubar = 0 ' no menu
oIE.toolbar = 0
oIE.statusbar = 1
oIE.navigate "http://gisweb/apps/doc_archive/scan_login.php?file_count="&fileCount
'WScript.Echo fileCount
oIE.visible = 1
' Important: wait till MSIE is ready
Do While (oIE.Busy)
Loop
' Wait till the user clicks the OK button
' Use the CheckVal function
' Attention: Thanks to a note from M. Harris, we can make
' the script a bit more fool proof. We need to catch the case
' that the user closes the form without clicking the OK button.
On Error Resume Next
Do ' Wait till OK button is clicked
WScript.Sleep 400
Loop While (oIE.document.script.CheckVal()=0)
' If an error occur, because the form is closed, quit the
' script
If err <> 0 Then
WScript.Echo "Sorry, a run-time error occured during checking" & _
" the OK button " & vbCRLF & _
"Error: " & err.number & " " & _
"I guess the form was getting closed..."
WScript.Quit ' end script
End if
On Error Goto 0 ' switch error handling off
' User has clicked the OK button, retrieve the values
docList = oIE.Document.ValidForm.doc_id_list.Value
'MsgBox doc_id
For i = 0 To 100000
x = 1
Next
oIE.Quit() ' close Internet Explorer
Set oIE = Nothing ' reset object variable
docArray = Split(docList,",")
i = 0
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
ext = oFSO.GetExtensionName(oFile)
filename = "p"&right("000000"&docArray(i),6)&"."&ext
base = Int(docArray(i) / 500) * 500
subdir = "d"&right("000000"&base,6)
oFSO.CopyFile oFile, "\\ditgis02\Enterprise_GIS\doc_archive\raw\"&subdir&"\"&filename, True
i = i + 1
End If
Next
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set WshShell = WScript.CreateObject("WScript.Shell")
intButton = WshShell.Popup (fileCount&" file(s) logged and copied! Do you want to delete temporary scan files?",0,"Done!",4)
If intButton = 6 Then
For Each oFile In scanFiles
oFile.Delete
Next
End If
Else
WScript.Echo(fileCount&" file(s) logged and copied!")
End If
WScript.Quit() ' Ready
' End
It looks the problem may arise if your initial test fails:
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
...
Else
Set scanFiles = WScript.Arguments
End If
You're setting the scanFiles variable to a collection of arguments, not files. Later on, near line 71 (where your error occurs), you're treating scanFiles as if it's a Files collection and attempting to access the Attributes property of one of its File objects:
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
...
Next
This won't be possible since scanFiles is an Arguments collection instead. So I think you need to fix your initial Else clause to either terminate your script or provide some kind of "default" Files collection.

HP Quality Center retrieve data from DB

I'm running a few vb scripts on my QC server using the script editor.
I'm using QC 12, i have a function that is establishing a connection using QC api, getting some data then incrementing this data by one, the thing is that it's getting an empty value from the DB.
Here is the function:
Function SW_KeepTIDLastValue()
On Error Resume Next
Dim tdc, val
Dim cset
Dim bld
On Error Resume Next
bld = ""
Set tdc = TDConnection 'Open a connection using the QC API
Set tdc = CreateObject("TDApiOle80.TDConnection")
Set cset = tdc.CommonSettings
'Set cset = tdc.COMMON_SETTINGS
cset.Open ("KeepTIDValueSetting")
val = cset.Value("KeepTIDValueField") 'Retrieve the value stored in the DB
' val = CDbl(cset.Value("KeepTIDValueField"))
msgbox(TypeName(val) & " " & val)
SW_KeepTIDLastValue = val+1 'Increment the value by 1
msgbox(TypeName(val) & " " & SW_KeepTIDLastValue )
cset.Value("KeepTIDValueField") = val+1 'Store the value back in the DB
cset.Close
If Err.Number <> 0 Then
SW_DisplayError Err.Number, Err.Description, "Keep Last Value (" & action & ")"
End If
On Error GoTo 0
End Function

Error code 0x8000500D when trying to access PasswordLastChanged

I'm writing a VBScript that will simply check each user in AD if their password has been changed within a given number of days. When I was trying to get it working for a single user, I came up with the following working code:
Option Explicit
Dim objUser, strLDAPConnection, intPwdExpLimit
strLDAPConnection = "CN=Test User,OU=Test,OU=Employees,DC=domain,DC=com"
intPwdExpLimit = 90
Set objUser = GetObject("LDAP://" + strLDAPConnection)
WScript.Echo DaysSincePwdChange(objUser)
Function DaysSincePwdChange(objUserAccount)
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
End Function
So then I tried to get it to work by looping through all users in a Test OU with the following code:
Option Explicit
Const strOffice = "Test"
Dim objEmployeesOU, objUser, intPwdExpLimit
intPwdExpLimit = 90
Set objEmployeesOU = GetObject("LDAP://OU=" & strOffice & _
",OU=Employees,DC=domain,DC=com")
For Each objUser In objEmployeesOU
If objUser.class = "user" Then
If ((DaysSincePwdChange(objUser)) >= intPwdExpLimit) Then
MsgBox(objUser & ": Password Expired.")
Else
MsgBox(objUser & ": Password Current.")
End If
End If
Next
Function DaysSincePwdChange(objUserAccount)
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
End Function
The above code produces a 0x8000500D error and googling the error says that it can't find the property in the cache (referring to the PasswordLastSet property, see error description link here).
Any ideas why the first block of code works fine but the second has a problem accessing that property?
Error code 0x8000500d means E_ADS_PROPERTY_NOT_FOUND. The password of the user has never been changed, so the property is not set. You could handle the condition like this:
Function DaysSincePwdChange(objUserAccount)
On Error Resume Next
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
If Err Then
If Err.Number = &h8000500d Then
DaysSincePwdChange = -1
Else
WScript.Echo "Unexpected Error (0x" & Hex(Err.Number) & "): " & _
Err.Description
WScript.Quit 1
End If
End If
End Function
and modify the check like this:
passwordAge = DaysSincePwdChange(objUser)
If passwordAge >= intPwdExpLimit) Then
MsgBox(objUser & ": Password Expired.")
ElseIf passwordAge = -1 Then
MsgBox(objUser & ": Password never changed.")
Else
MsgBox(objUser & ": Password Current.")
End If

To run two or more .VBS script parallely

I have two .vbs file say a.vbs and b.vbs.Now both are written for the same Excel,but would work on 2 different sheets.So can we run those in parallel?
EDIT
a.vbs will update sheet2 and b.vbs will update sheet3.But for both source sheet is sheet1.
Please advice how to set such environment
CODE A
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim ColStart
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
strPathExcel1 = "D:\AravoVB\Copy of Original Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets("Bad Data")
objExcel1.ScreenUpdating = False
objExcel1.Calculation = -4135 'xlCalculationManual
IntRow2=2
IntRow1=4
Do Until IntRow1 > objSheet1.UsedRange.Rows.Count
ColStart = objExcel1.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0) + 1
Do Until ColStart > objSheet1.UsedRange.Columns.Count And objSheet1.Cells(IntRow1,ColStart) = ""
If objSheet1.Cells(IntRow1,ColStart + 1) > objSheet1.Cells(IntRow1,ColStart + 5) And objSheet1.Cells(IntRow1,ColStart + 5) <> "" Then
objSheet1.Range(objSheet1.Cells(IntRow1,1),objSheet1.Cells(IntRow1,objSheet1.UsedRange.Columns.Count)).Copy
objSheet2.Range(objSheet2.Cells(IntRow2,1),objSheet2.Cells(IntRow2,objSheet1.UsedRange.Columns.Count)).PasteSpecial
IntRow2=IntRow2+1
Exit Do
End If
ColStart=ColStart+4
Loop
IntRow1=IntRow1+1
Loop
objExcel1.ScreenUpdating = True
objExcel1.Calculation = -4105 'xlCalculationAutomatic
CODE B
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim Flag
Dim IntColTemp,IntRowTemp
Dim Strcmp1,Strcmp2
Flag=0
IntColTemp=1
IntRowTemp=3
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets(2)
IntRow1=4
IntRow2=1
Do While objSheet1.Cells(IntRow1, 1).Value <> ""
objSheet2.Cells(IntRow2, 1).Value = objSheet1.Cells(IntRow1, 1).Value
IntColTemp=1
Flag=0
'This will travarse to the Parent Business Process ID column horizantally in the excel.
Do While Flag=0
If objSheet1.Cells(IntRowTemp,IntColTemp).Value="Parent Business Process ID" Then
Flag=1
End If
IntColTemp=IntColTemp+1
Loop
IntColTemp=IntColTemp-1
'MsgBox(IntColTemp)
Strcmp1=trim(objSheet1.Cells(IntRow1, 1).Value)
Strcmp2=trim(objSheet1.Cells(IntRow1,IntColTemp).Value)
If Strcmp1=Strcmp2 Then
objSheet2.Cells(IntRow2, 2).Value="Parent"
Else
objSheet2.Cells(IntRow2, 2).Value="child"
End If
IntRow1=IntRow1+1
IntRow2=IntRow2+1
Loop
Working on two different sheets should be possible by putting something like this in both of your scripts:
strPathExcel1 = "D:\CopyofGEWingtoWing_latest_dump_21112012.xls"
On Error Resume Next
Set objExcel1 = GetObject(, "Excel.Application") ' attach to running instance
If Err.Number = 429 Then ' if that fails
Err.Clear
Set objExcel1 = CreateObject("Excel.Application") ' create new instance
If Err Then ' if that still fails
WScript.Echo Err.Description & " (0x" & Hex(Err.Number) & ")"
WScript.Quit 1 ' report error and terminate
End If
objExcel1.Workbooks.Open strPathExcel1
End If
On Error Goto 0
However, I doubt that this approach would gain you enough performance to justify the additional complexity.
In CODE A replace the lines
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
strPathExcel1 = "D:\AravoVB\Copy of Original Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
with the above code block.
In CODE B replace the lines
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
with the above code block.

Resources