ComboBox strategies to function - methods

I have four combo box everything does the same as follows:
Select Case combobox1.selectedItem
case 0
str=str & "' AND"
case 1
str= str & "'"
end case
select case combobox2.selected item
case 0
str=str & "' AND"
case 1
str= str & "'"
end case
Similarly the other two comboboxes have the same body
I want to replace this code block by a method call and implement the select clause body in a method body and call it when required.
Please give me a solution

Create a method that takes the input as combobox selected index i.e an integer
now in the method write as follows:
method1(int x)
{
Select Case x
case 0
str=str & "' AND"
case 1
str= str & "'"
end case
}
Call method1 where required.

Related

How to read dt_DBTIME2 with VBScript

I'm trying to read a recordset from SQL database were some field are of type time(n).
When I read a row (recordset.Fields(n)), VBScript stops at this field with a 'multiple step error'.
I tried to set a variable with the recordset, so:
Dim a
Set a = recordset.Fields(specific time column)
I tried to cast the field.
I tried to find any information about this specific type, but I can't find any information about this time structure, besides it contains hour, minute, second and fractional parts.
ReDim iArr(iColumnCount)
While Not objRecordset.EOF
For iColumnIndex = 0 To (iColumnCount-1)
'SQL_FIELDTYPE_TIME is a constant at top of page with value 145
If objRecordset.Fields(iColumnIndex).Type = SQL_FIELDTYPE_TIME Then
'Tried so much over here...
Dim Tme, Str
Set Tme = objRecordset.Fields.Item(iColumnIndex)
iArr(iColumnIndex) = CStr(clDBTime(Tme).Hour)
Set Tme = Nothing
Else
iArr(iColumnIndex) = objRecordset.Fields.Item(iColumnIndex)
End If
If Err.Number <> 0 Then
fLogData("Ophalen data (" + oDB.strDatabaseNaam + ") rij " + _
CStr(objRecordset.AbsolutePosition) + " kolom " + _
CStr(iColumnIndex) + " mislukt: " + Err.Description)
Err.Clear
End If
Next
List.Add i, iArr
i = i + 1
objRecordset.MoveNext 'Next row
Wend
Errors I'm getting:
Object doesn't support this property
Multiple step error
Type mismatch
etc. etc.
Anyone who can help me out how to read the time value from SQL in VBScript?
EDIT: solved! Cost almost 4h trial-error but there's a solution:)
Changed the SQL select statement to:
SELECT COL, COL,... (this are the 'usual' columns),CAST(TIMECOL -this is the time(n) column- as varchar),CAST(TIMECOL2 -this is the time(n) column- as varchar) FROM tabel
And within code: TimeValue(read value - from recordset.fields...) (this is to change varchar back to time)
And .. it just works great!
Edit2: recordset code:
if iResCount > 0 and iColumnCount > 0 then
redim iArr(iColumnCount)
while not objRecordset.EOF
for iColumnIndex = 0 to (iColumnCount-1)
iArr(iColumnIndex) = objRecordset.Fields.Item(iColumnIndex)
if Err.Number <> 0 then
fLogData("Ophalen data ("+oDB.strDatabaseNaam+") rij "+cstr(objRecordset.AbsolutePosition)+ " kolom "+cstr(iColumnIndex)+" mislukt: "+Err.Description)
Err.Clear
end if
next
List.Add i, iArr
i = i + 1
objRecordset.MoveNext 'Next row
wend
set oResult = List'CreateObject("Scripting.Dictionary")
end if
And an example of a function call:
'fGetRecord(DB, Table, Columns, Condition, Field to sort on, Type of sort)
fGetRecord(oHoofdDB,CONST_HDB_STR_TBL_KALENDER,CONST_HDB_STR_KAL_ID+","+CONST_HDB_STR_KAL_NAAM+",CAST("+CONST_HDB_STR_KAL_STARTIJD+" as varchar),CAST("+CONST_HDB_STR_KAL_STOPTIJD+" as varchar)",CONST_HDB_STR_KAL_NAAM+"='"+Naam+"'", "", SORTEER_OPLOPEND)
John

Access 2010 string issue with letters "AJ"

in Access 2010 (x64) I have a method declared in a class module as below:
Public Sub addFieldAndValueToXML(fieldName As String, value As String)
xmlStr = xmlStr & "<field name=""" & fieldName & """><value>" & value & "</value></field>"
End Sub
I call it from a method on a form as below:
For i = 0 To 4
If Not .EOF Then
Dim n As Integer
n = i + 1
'Stop
builder.addFieldAndValueToXML "FINDINGS Include applicable referencesRow" & n, Nz(!FIndings, "")
Select Case !RatingID
Case 1
builder.addFieldAndValueToXML "MAJORRow" & n, "X"
builder.addFieldAndValueToXML "MINORRow" & n, ""
Case 2
builder.addFieldAndValueToXML "MAJORRow" & n, ""
builder.addFieldAndValueToXML "MINORRow" & n, "X"
Case Else
builder.addFieldAndValueToXML "MAJORRow" & n, ""
builder.addFieldAndValueToXML "MINORRow" & n, ""
End Select
builder.addFieldAndValueToXML "FOCUS AREARow" & _
n, Left(DLookup("Discrepancy_Type", "DiscrepancyType_Tbl", "DiscrepancyTypeID =" & !DiscrepancyTypeID), 1)
.MoveNext
End If
Next i
The purpose of the code is to build an xml string that is output to a .xfdf file, and it appears to be working fine except for the lines where fieldName is given the value "MAJORRow".
When I step through the code I can see that the lines prior to, and after the offending lines call the method properly, and I can see the fieldName and value arguments being populated properly.
However on the offending lines, fieldName is not being populated at all, whereas value is.
I've tried a number of different values for fieldName ("majorrow", "maj_row", "MAJ_Row", etc.) and when the combination "AJ" (has to be capitalized) is in the string, it fails to populate fieldName.
I've checked for reserved words, and done a fair bit of searching but can find nothing relating to this at all. Has anyone else come across this?
I'm running Windows 10 (x64).
Cheers.

Excel VBA return behaving weirdly, jumps back to

Private Function GetLastSameRow(ByVal row, initialValue) As Integer
.
.
.
If (nextCell.Value = initialValue) Then
GetLastSameRow = GetLastSameRow(row + 1, initialValue)
End If
MsgBox ("returning : " & row)
GetLastSameRow = row
End Function
After it finishes the if statement, the behaviour is really weird.
I ran debugger on it, and this is how it jumps:
1. End If '
2. MsgBox ("returning : " & row) ' row value is 3
3. GetLastSameRow = row '
4. MsgBox ("returning : " & row) ' row value is 2 ????????
5. GetLastSameRow = row '
So basically it wants to return the correctvalue, but then jumps back to End if and gets correct-1 value from out of the blue.
You've written a recursive function! If you use the call stack, you'll see that the debugger is going to a different instance of your function. The problem lies with:
GetLastSameRow = GetLastSameRow(row + 1, initialValue)
which is calling another instance of the function.

QTP: Checking If an array of strings contains a value

I am having trouble getting my test case to run correctly.
The problem is in the code below, the first if statement to be exact. QTP complains that an object is required
For j=Lbound(options) to Ubound(options)
If options(j).Contains(choice) Then
MsgBox("Found " & FindThisString & " at index " & _
options.IndexOf(choice))
Else
MsgBox "String not found!"
End If
Next
When I check the array I can see that it is populated correctly and 'j' is also the correct string.
Any help with this issue would be greatly appreciated.
Strings in VBScript are not objects, in that they do not have member functions. Searching for a substring should be done by using the InStr function.
For j=Lbound(options) to Ubound(options)
If InStr(options(j), choice) <> 0 Then
MsgBox("Found " & choice & " at index " & j
Else
MsgBox "String not found!"
End If
Next
A concise way to check if an array of strings contains a value would be to combine the Filter and UBound functions:
If Ubound(Filter(options, choice)) > -1 Then
MsgBox "Found"
Else
MsgBox "Not found!"
End If
Cons: you don't get the indexes where the elements are found
Pros: it's simple and you have the usual include and compare parameters to specify the matching criteria.
Function CompareStrings ( arrayItems , choice )
For i=Lbound(arrayItems) to Ubound(arrayItems)
' 0 - for binary comparison "Case sensitive
' 1 - for text compare not case sensitive
If StrComp(arrayItems(i), choice , 0) = 0 Then
MsgBox("Found " & choice & " at index " & i
Else
MsgBox "String not found!"
End If
Next
End Function
Hi if you check exact String not sub-String in the array use StrComb because if use InStr then if array = "apple1" , "apple2" , "apple3" , "apple" and choice = "apple" then all will return pass for every array item.
Function CompareStrings ( arrayItems , choice )
For i=Lbound(arrayItems) to Ubound(arrayItems)
' 1 - for binary comparison "Case sensitive
' 0 - not case sensitive
If StrComp(arrayItems(i), choice , 1) = 0 Then
CompareStrings = True
MsgBox("Found " & choice & " at index " & i
Else
CompareStrings = False
MsgBox "String not found!"
End If
Next
End Function

QTP: How can I return multiple Values from a Function

I'm trying to write a function which can return multiple values from a Function which is having 2 arguments.
eg:
function sample_function(arg1,arg2)
''#Some code.................
passenger = list1(0)
name1 = list1(1)
age1 = list1(2)
seatNumber = list1(3)
''#This is an Incomplete function...
end function sample_function
Here this function named sample_function has 2 argument named arg1, arg2. When i call this function in my Driver Script like value = sample_function(2,Name_person), this function should return me passenger, name1,age1,seatNumber values.
How can i achieve this?
EDIT (LB): QTP uses VBScript to specify the test routines, so I retagged this to VBScript, VB because the solution is probably within VBScript.
A straightforward solution would be to return an array:
function foo()
foo=array("Hello","World")
end function
x=foo()
MsgBox x(0)
MsgBox x(1)
If you happen to use the same batch of values more often than once, then it might pay to make it a user defined class:
class User
public name
public seat
end class
function bar()
dim r
set r = new User
r.name="J.R.User"
r.seat="10"
set bar=r
end function
set x=bar()
MsgBox x.name
MsgBox x.seat
In VBScript, all function parameters are input/output parameters (also called ByRef parameters). So you could return your data simply using the function parameters. Example:
Function Test(a, b, c)
a = 1
b = 2
c = 3
End Function
Test x, y, z
MsgBox x ' Shows 1
MsgBox y ' Shows 2
MsgBox z ' Shows 3
You can create a new Datatype and add all necessary members in it. Then return this new datatype from your function.
You can do it by returning dictionary object from the function .
set dictFunRetun=foo()
msgbox dictFunRetun.item("Msg1")
msgbox dictFunRetun.item("Msg2")
function foo()
set fnReturn=CreateObject("Scripting.Dictionary")
fnReturn.Add "Msg1","First Variable"
fnReturn.Add "Msg2","Second Variable"
set foo=fnReturn
end function
here in dictionary i have added to keys named Msg1 and Msg2 similarly we can add more keys with having value of different types like int, Boolean ,array any type of data ..
declare your function like this.
function sample (arg1, arg2, passenger, name, age1, seatNumber)
''#Some code.................
passenger = list1(0)
name1 = list1(1)
age1 = list1(2)
seatNumber = list1(3)
''#This is an Incomplete function...
end function sample
then when you call it just input the variables you want to return.
This will Help you,
you can do it in two methods first one is to pass all values as array for example
function message
message1="Hello How are you?"
message2="i am fine"
message3="Hope you doing fine"
message=Array(message1,message2,message3)
End function
function chat-history
user-history=message
usermessage1=user-history(0)
usermessage2=user-history(1)
usermessage3=user-history(2)
End Function
The Second method is to concatenate and split
function message
message1="Hello How are you?"
message2="i am fine"
message3="Hope you doing fine"
message=message1+"#"+message2+"#"+message3
End function
function chat-history
user-history=message
user-message=split(user-history,"#")
usermessage1=user-message(0)
usermessage2=user-message(1)
usermessage3=user-message(2)
End Function
I own nothing. All credit goes to the hardwork of my online friends pradeek and another friend. I hope this helps someone.
'Passing multiple numerical values from one function to another method-1
Function fnFirstFunction()
value1=1
value2=2
value3=3
A=Array(value1,value2,value3)
fnFirstFunction=A
'msgboxA(0)
'msgboxA(1)
End Function
'Belowfunction passes the value returned from the fnFirstFunction and displays
Function fnSecondFunction(ByVal A)
P=A
B=P(0)
MsgBox B
C=P(1)
Msgbox C
D=P(2)
Msgbox D
End Function
A=fnFirstFunction()
'AsfnFirstFunction returns a value, take it to a variable
Call fnSecondFunction(A)'a
'passing multiple character values from one function to another method -2
public function fun1()
msg1="Hello How are you?"
msg2="i am fine"
msg3="Hope you doing fine"
arr1=Array(msg1,msg2,msg3)
fun1=arr1
End function
arr1=fun1()
Call fun2(arr1)
public function fun2(byval arr1)
j=arr1
usermessage1=j(0)
msgbox usermessage1
usermessage2=j(1)
msgbox usermessage2
usermessage3=j(2)
msgbox usermessage3
End Function
'Passing multiple values from one function to another method-3
public function fun1()
msg1="Hello How are you?"
msg2="i am fine"
msg3="Hope you doing fine"
arr1=msg1 + "#" + msg2 + "#" + msg3
fun1=arr1
End function
arr1=fun1()
Call fun2(arr1)
public function fun2(byval arr1)
j=arr1
k= split(j,"#")
usermessage1=k(0)
msgbox usermessage1
usermessage2=k(1)
msgbox usermessage2
usermessage3=k(2)
msgbox usermessage3
End Function
By using dictionary Object.This is your function
Function sample_function(ByRef passengerDetails)
''#Some code.................
passengerDetails("passenger")=list(0)
passengerDetails("name")=list(1)
passengerDetails("age")=list(2)
passengerDetails("seatnumber")=list(3)
'#This is an Incomplete function...
end function
'Creating a dictionary object
Set passengerDetails= CreateObject("Scripting.Dictionary")
'calling your function
sample_function(passengerDetails)
Advantage of using dictionary object is, sometime down the line you want the function to return more values(and this function is used by many projects/teams), you have to do is add the values you want to return in the dictionary object, without having to add more parameters(others using this function wont get any error)
If you are sure that the list1 array carry only required data in same manner as you posted. Then you can directly pass the array from function too:-
function sample_function(arg1,arg2)
''#Some code.................
passenger = list1(0)
name1 = list1(1)
age1 = list1(2)
seatNumber = list1(3)
sample_function list1
end function
Option Explicit
Dim val1, val2
Dim res1, res2, res3, res4
Print "Calling a Sub function"
funcMath1 10, 25, "m"
funcMath1 10, 25, "S"
funcMath1 10, 25, "D"
funcMath1 10, 25, "A"
funcMath1 10, 25, "C"
'==============================================
' Date : 09/21/2012
' Created By : Jamil
' VB Script Basic Sub Function and Function Test
'==============================================
Option Explicit
Dim val1, val2
Dim res1, res2, res3, res4
Print "Calling a Sub function"
funcMath1 10, 25, "m"
funcMath1 10, 25, "S"
funcMath1 10, 25, "D"
funcMath1 10, 25, "A"
funcMath1 10, 25, "C"
'(1) simple calculater sub function with no return value
Function funcMath1(val1, val2, opt)
Dim result
Select Case UCase(opt)
Case "M"
result = (val1 * val2)
Print "The result of multiplying is " &val1& " With " &val2& " is " &result
Case "S"
result = (val1 - val2)
Print "The result of subtraction is " &val1& " With " &val2& " is " & result
Case "D"
result = (val1 / val2)
Print "The result of divide is " &val1& " With " &val2& " is " & result
Case "A"
result = (val1 + val2)
Print "The result of Addtion is " &val1& " With " &val2& " is " & result
Case else
msgBox "Your option "& opt &" is invalid!"
End Select
End Function
Print " "
Print "Calling a function"
call funcMath2(10, 25, "M")
call funcMath2(10, 25, "S")
call funcMath2(10, 25, "D")
call funcMath2(10, 25, "A")
call funcMath2(10, 25, "C")
'(2) simple calculater function with return value
Function funcMath2(val1, val2, opt)
Dim result, returnValue
Select Case UCase(opt)
Case "M"
result = (val1 * val2)
Print "The result of multiplying is " &val1& " With " &val2& " is " &result
Case "S"
result = (val1 - val2)
Print "The result of subtraction is " &val1& " With " &val2& " is " & result
Case "D"
result = (val1 / val2)
Print "The result of divide is " &val1& " With " &val2& " is " & result
Case "A"
result = (val1 + val2)
Print "The result of Addtion is " &val1& " With " &val2& " is " & result
Case else
msgBox "Your option "& opt &" is invalid!"
End Select
funcMath2 = result
End Function

Resources