I'm working on an application in vb6 that draws information from a database. I've come across many problems that come from null values in the database as vb6 functions and subroutines don't like nulls. The string problem is easily solved by concatenating an empty string to the value. But what do I do for a null value where a boolean should be?
Thanks for your help!
This assumes you are using the ADO objects for data access.
Dim boolField As Boolean
If Not IsNull(fields("FieldName").value) Then
boolField = CBool(fields("FieldName").value)
End If
I'm using most of these function to handle nulls
'--- type-casting without errors'
Public Function C2Str(Value As Variant) As String
On Error Resume Next
C2Str = CStr(Value)
On Error GoTo 0
End Function
Public Function C2Lng(Value As Variant) As Long
On Error Resume Next
C2Lng = CLng(Value)
On Error GoTo 0
End Function
Public Function C2Cur(Value As Variant) As Currency
On Error Resume Next
C2Cur = CCur(Value)
On Error GoTo 0
End Function
Public Function C2Dbl(Value As Variant) As Double
On Error Resume Next
C2Dbl = CDbl(Value)
On Error GoTo 0
End Function
Public Function C2Date(Value As Variant) As Date
On Error Resume Next
C2Date = CDate(Value)
On Error GoTo 0
End Function
Public Function C2Bool(Value As Variant) As Boolean
On Error Resume Next
C2Bool = CBool(Value)
On Error GoTo 0
End Function
You can use C2Bool in your case :-))
This is an old problem with VB6 and ASP. I use Trim(l_BankAccount.Recordset.Fields("BANKCODE").value & " ") which gets rid of many problems including the dbNull.
For a whole number field CLng("0" & Trim(l_BankAccount.Recordset.Fields("BANKCODE").value & " "))
works.
Try using isnull and specifying the .value of the field, as otherwise the isnull() checks the field object (and not the value):
If (IsNull(l_BankAccount.Recordset.Fields("BANKCODE").value) = True) Or _
Related
I am new to vb6 so might be obvious for some of you.I have a collection problem, trying to put items in a collection to then evaluate if the item exists and setting a button to be enabled or not.
The Code:
For Each vBookmark In lstAssign.SelBookmarks
'---------------------------------------
'filtering with agency code and crew code.
sAssignmentValue = lstAssign.columns("AgencyCode").Value & lstAssign.columns("CrewCode").Value
'Show/hide value depending on crew existance.
If Not ExistsStartLocation(colParameters, sValue) Then
bEnableMyButton = True
colParameters.Add (sValue)
Else
bEnableMyButton = False
End If
'----------------------------------------
Next
sAssignmentValue = ""
tbrMain.TbrButtonEnabled "XXX", bEnableMyButton
tbrMain.TbrButtonEnabled "YYY", bEnable
Set colStartLocationParameters = Nothing
Exit Sub
Private Function ExistsStartLocation(col As collection, index As Variant) As Boolean
On Error GoTo ErrHandler
Dim v As Variant
v = col(index)
ExistsStartLocation = True
Exit Function
ErrHandler:
ExistsStartLocation = False
End Function
The problem is at this moment is that I only have colParameters(index) accessible, so I can't access my collection with a value "123-ABC" directly. I do not want to add an integer index, I want to keep simply accessing by item value, but my exists method will always return false. therefore always disabling my button.
How does this works?
At first glance, you should have to do something like this:
Private Function ExistsStartLocation(col As collection, val As String) As Boolean
Dim blnFoundItem As Boolean = False
For index As Integer = 1 To col.Count
If col(index) = val Then
blnFoundItem = True
End If
Next
ExistsStartLocation = blnFoundItem
End Function
Looping the collection works but is not efficient. If you assign the optional Key value in the Add method you can also use that as the Index to the Item method. In your example it appears you are assigning a string to the collection so the Add method would look something like ...
colParameters.Add sValue, sValue
Be aware though that if you are adding duplicate values this won't work. The keys need to be unique.
With the the collection item's key populated you can use a function that leverages the err object. If you try to get a collection item by the key and it exists no error is thrown. If it does not exists err.number 5 is thrown. The new function would be something like this.
Public Function ItemExists(ByVal vCollection As Collection, ByVal vKey As String) As Boolean
Dim varItem As Variant
On Error Resume Next
varItem = vCollection.Item(vKey)
ItemExists = (Err.Number = 0)
End Function
I have wrote this below function. However, i keep getting invalid function argument in QTP.
The object is a link in a webtable and i keep getting this error message of "The statement contains one or more invalid function agrument."
Can someone help me please?
Function CheckData(Value_To_Match, Rpttext, ByRef Row_Num)
Dim tab_val, arr_val(2), rowNum
tab_val = Split(Value_To_Match,";")
arr_val(0) = Browser("xyz").Page("abc").WebTable("xsw").getColumnIndex(tab_val(0))
If UBound(tab_val ) > 0 Then
arr_val(1) = tab_val(1)
arr_val(2) = Browser("xyz").Page("abc").WebTable("xsw").getMatchingRow(arr_val)
Row_Num = arr_val(2)
Browser("xyz").Page("abc").WebTable("xsw").MatchVal arr_val, Rpttext, "Verify"
Else
arr_val(1) = tab_val(0)
arr_val(2) = Browser("xyz").Page("abc").WebTable("xsw").getMatchingRow(arr_val)
Browser("xyz").Page("abc").WebTable("xsw").MatchVal arr_val, Rpttext, "Verify"
arr_val(2) = Row_Num
Browser("xyz").Page("abc").WebTable("xsw").MatchVal arr_val, Rpttext, "Check"
End If
End Function
If Trim(Parameter("DraftsViewDraftIcon")) <> "" And _
LCase(Trim(Parameter("DraftsViewDraftIcon"))) <> "[null]" And _
LCase(Trim(Parameter("Wrapper_Mode"))) ="set" Then
Set ViewDraftLink = Browser("xyz").Page("abc").WebTable("xsw").ChildItem(Row_Num, 4, "Link", 0)
ViewDraftLink.click
End If
This function below for getting matching Row
Public Function getMatchingRow(byRef object, byVal arraydata)
Dim introw
Dim varComp
On Error Resume Next
If UBound(arraydata) = 0 Then
Reporter.ReportEvent micFail, "Array Data", "No Data found in input parameter Array"
getMatchingRow = 0
Exit Function
End If
For introw = 1 to object.RowCount
varComp = StrComp(Trim(object.GetCellData(introw, arrayData(0))), Trim(arrayData(1)), 0)
If varComp = 0 And Not(isNull(varComp)) Then
getMatchingRow = introw
Exit Function
End If
Next
getMatchingRow = 0
On Error Goto 0
If you want to register the getMatchingRow function as a method, the first formal argument must be a byVal parameter:
Public Function getMatchingRow(byVal object, byVal arraydata)
You are using a byRef argument:
Public Function getMatchingRow(byRef object, byVal arraydata)
This might cause the trouble you´re experiencing.
I don't have a chance to verify this right now, but please give it a try anyways.
(I have some doubt about this answer of mine, especially because you say the error line is the Set ViewDraftLink assignment, while it should happen upon the .getMatchingRow call. But you also mention the ViewDraftLink.Click and End If lines in that comment, so you are being unprecise in that regard anyway.
It really would help if you merge all this info into the question, further clean up the code in the question, and delete the then-obsolete comments.)
What is the best way in VB6 to pass an error back to the calling function?
1 On Error Resume Next
2 ' do something
3 If Err.Number <> 3026 Or Err <> 0 Then ?????????
How would you send the error in Line 3 back to the calling function? Is the following the only way to achieve this?
errNum = Err.Number
On Error Goto 0
Err.Raise errNum
Use On Error GoTo and re-raise the error in the handler with Err.Raise.
Private Function DoSomething(ByVal Arg as String)
On Error GoTo Handler
Dim ThisVar as String
Dim ThatVar as Long
' Code here to implement DoSomething...
Exit Function
Handler:
Err.Raise Err.Number, , "MiscFunctions.DoSomething: " & Err.Description
End Function
You'll then be able to get the error number and description in the caller via Err.Number and Err.Description.
If the caller is also using On Error GoTo, you'll see them in the handler there.
If the caller is using On Error Resume Next, then you can still use those same variables inline.
I prefer the first option, using On Error Goto in all functions and subs, because it seems like the natural way to use VB6's built-in error raising features. You can also update the description in the called function's handler, like the example above, and get a pseudo call stack you can eventually log or display to yourself during debugging.
More VB6 error handling thoughts here:
Is it possible to retrieve the call stack programmatically in VB6?
How to clean up error handling in a function?
Why not add ByRef errorCode as Long to the called function's args and set it equal to Err.Number after ' do something
Or you could have a public field called ErrorCode as Long that you could set after ' do something
I have worked with a lot of industrial control APIs and both of these methods have been used.
You can easily send the error to the upper (calling) sub/function as long as the function that raises the error does not have (ON ERROR RESUME ---), that way, error handling is left in the upper level only. Otherwise you will have to handle the error inside the called function
Private Sub Command1_Click()
Dim test As Integer
On Error Resume Next
test = myFunction 'Calling a function that is known to have an error
If Err <> 0 Then
MsgBox "MyFunction failed because:" & Err.Description 'Error is passed
End If
End Sub
'--------------------------
Function myFunction() As Integer
Dim i As Integer
i = 1
i = 4 / 0 'This will raise an Error, and control returns to the calling sub
i = 2 'This will never get executed
myFunction = i
End Function
If you simply want to pass the error back to the original caller without handling it, then you want to remove any ON ERROR in the child function:
Public Sub ParentSub()
On Error GoTo ErrorHandler
' do something
Call ChildSub()
' do something
Exit Sub
ErrorHandler:
' handle the error here
End Sub
Public Sub ChildSub()
' do something
' if there is an error here, the error will be handled in ErrorHandler of ParentSub
End Sub
or if you want to handle it in both subs:
Public Sub ParentSub()
On Error GoTo ErrorHandler
' do something
Call ChildSub()
' do something
Exit Sub
ErrorHandler:
' handle the error here
End Sub
Public Sub ChildSub()
On Error GoTo ErrorHandler
' do something
Exit Sub
ErrorHandler:
' handle the error here and pass it back to the ParentSub to handle it as well
Err.Raise Err.Number
End Sub
I want to pass the string value to function
Function Code
Private Function Assign(Div As String)
sSQL = "Insert into table2 Select * from table1 Where Divi_Code = '" & Div & "'"
Rdoconn.Execute sSQL, rdExecDirect
End Function
Button Click Code
Dim Div as string
Div = "Hai,Howareyou"
Assign Div 'Getting Error as "ByRef arguement type mismatch"
The above code is shwoing error as Getting Error as "ByRef arguement type mismatch"
I tried the following code, and I am not getting any ByRef argument mismatch.
Private Function Assign(Div As String)
ssql = "Insert into table2 Select * from table1 Where Divi_Code = '" & Div & "'"
MsgBox ssql
End Function
Private Sub Command1_Click()
Dim Div As String
Div = "Hai,Howareyou"
Assign Div
End Sub
I am really puzzled why your code is giving you an error. However, there are a couple of things you should change in your code and I'm confident this will resolve your problem:
The function parameter should be declared ByVal. In VB6, parameters are ByRef by default unless specified. This means that the function call could have side-effects in the parent procedure if for any reason the parameter Div is modified. Always use ByVal unless you really need to modify the parameter value:
Private Function Assign(ByVal Div As String)
Is there any reason why you declared Assign as a Function? Are you intending to return a value? If not, you should use Private Sub instead of Private Function (and End Sub at the end). This is equivalent to using the void return type in C. For your reference, you should always define the return type of your functions in VB6, otherwise Variant will be assumed. The return type can be fined in functions using the "As" keyword at the end of the declaration:
Private Function Add(ByVal n1 as Integer, ByVal n2 As Integer) As Integer
One last thing I'd like to add is that you never, ever should concatenate variables to SQL queries like this. At the very least, the code will crash if the name contains an apostrophe (ex: try calling it with "I'm very well"), and at worst, you'll be opening up for SQL injection attacks where someone could use this to run specially crafted queries on your database. While I'm not familiar with RDO, you should check out MSDN - this article mentions how to create parameter queries with RDO.
To call a Function declared as
Private Function AssignDiv(Div As String, Dep As String)
you'd need something like
AssignDiv Div, "WhatEverDep"
Your
Assign Div
is completely wrong.
You changed your declaration to
Private Function AssignDiv(Div As String)
but the function's name is still wrong.
You changed your code again. Now names and parameters match, so if you still get an error, it's not caused by the code you published.
to begin with I don't understand why you are setting you Div value and then passing it into your function, you may as well pass it in directly on the button click, and then also I can't see that sSQL is actually defined as a string, please try the following code:
Public Function Assign(strDiv As String)
Dim sSQL As String
sSQL = "Insert into table2 Select * from table1 Where Divi_Code = '" & strDiv & "'"
Rdoconn.Execute sSQL, rdExecDirect
End Function
And then call from the button click as:
Private Sub Command1_Click()
Call Assign("Hai,Howareyou")
End Sub
I've inherited a large VB6 app at my current workplace. I'm kinda learning VB6 on the job and there are a number of problems I'm having. The major issue at the moment is I can't figure out how to check if a key exists in a Collection object. Can anyone help?
My standard function is very simple. This will work regardless of the element type, since it doesn't bother doing any assignment, it merely executes the collection property get.
Public Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean
On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear
End Function
#Mark Biek Your keyExists closely matches my standard Exists() function. To make the class more useful for COM-exposed collections and checking for numeric indexes, I'd recommend changing sKey and myCollection to not be typed. If the function is going to be used with a collection of objects, 'set' is required (on the line where val is set).
EDIT: It was bugging me that I've never noticed different requirements for an object-based and value-based Exists() function. I very rarely use collections for non-objects, but this seemed such a perfect bottleneck for a bug that would be so hard to track down when I needed to check for existence. Because error handling will fail if an error handler is already active, two functions are required to get a new error scope. Only the Exists() function need ever be called:
Public Function Exists(col, index) As Boolean
On Error GoTo ExistsTryNonObject
Dim o As Object
Set o = col(index)
Exists = True
Exit Function
ExistsTryNonObject:
Exists = ExistsNonObject(col, index)
End Function
Private Function ExistsNonObject(col, index) As Boolean
On Error GoTo ExistsNonObjectErrorHandler
Dim v As Variant
v = col(index)
ExistsNonObject = True
Exit Function
ExistsNonObjectErrorHandler:
ExistsNonObject = False
End Function
And to verify the functionality:
Public Sub TestExists()
Dim c As New Collection
Dim b As New Class1
c.Add "a string", "a"
c.Add b, "b"
Debug.Print "a", Exists(c, "a") ' True '
Debug.Print "b", Exists(c, "b") ' True '
Debug.Print "c", Exists(c, "c") ' False '
Debug.Print 1, Exists(c, 1) ' True '
Debug.Print 2, Exists(c, 2) ' True '
Debug.Print 3, Exists(c, 3) ' False '
End Sub
I've always done it with a function like this:
public function keyExists(myCollection as collection, sKey as string) as Boolean
on error goto handleerror:
dim val as variant
val = myCollection(sKey)
keyExists = true
exit sub
handleerror:
keyExists = false
end function
As pointed out by Thomas, you need to Set an object instead of Let. Here's a general function from my library that works for value and object types:
Public Function Exists(ByVal key As Variant, ByRef col As Collection) As Boolean
'Returns True if item with key exists in collection
On Error Resume Next
Const ERR_OBJECT_TYPE As Long = 438
Dim item As Variant
'Try reach item by key
item = col.item(key)
'If no error occurred, key exists
If Err.Number = 0 Then
Exists = True
'In cases where error 438 is thrown, it is likely that
'the item does exist, but is an object that cannot be Let
ElseIf Err.Number = ERR_OBJECT_TYPE Then
'Try reach object by key
Set item = col.item(key)
'If an object was found, the key exists
If Not item Is Nothing Then
Exists = True
End If
End If
Err.Clear
End Function
As also advised by Thomas, you can change the Collection type to Object to generalize this. The .Item(key) syntax is shared by most collection classes, so that might actually be useful.
EDIT Seems like I was beaten to the punch somewhat by Thomas himself. However for easier reuse I personally prefer a single function with no private dependencies.
Using the error handler to catch cases when the key does not exists in the Collection can make debugging with "break on all errors" option quite annoying. To avoid unwanted errors I quite often create a class which has the stored objects in a Collection and all keys in a Dictionary. Dictionary has exists(key) -function so I can call that before trying to get an object from the collection. You can only store strings in a Dictionary, so a Collection is still needed if you need to store objects.
The statement "error handling will fail if an error handler is already active" is only partly right.
You can have multiple error handlers within your routine.
So, one could accommodate the same functionality in only one function.
Just rewrite your code like this:
Public Function Exists(col, index) As Boolean
Dim v As Variant
TryObject:
On Error GoTo ExistsTryObject
Set v = col(index)
Exists = True
Exit Function
TryNonObject:
On Error GoTo ExistsTryNonObject
v = col(index)
Exists = True
Exit Function
ExistsTryObject:
' This will reset your Err Handler
Resume TryNonObject
ExistsTryNonObject:
Exists = False
End Function
However, if you were to only incorporate the code in the TryNonObject section of the routine, this would yield the same information.
It will succeed for both Objects, and non-objects.
It will speed up your code for non-objects, however, since you would only have to perform one single statement to assert that the item exists within the collection.
Better solution would be to write a TryGet function. A lot of the time you are going to be checking exists, and then getting the item. Save time by doing it at the same time.
public Function TryGet(key as string, col as collection) as Variant
on error goto errhandler
Set TryGet= col(key)
exit function
errhandler:
Set TryGet = nothing
end function
see
http://www.visualbasic.happycodings.com/Other/code10.html
the implementation here has the advantage of also optionally returning the found element, and works with object/native types (according to the comments).
reproduced here since the link is no longer available:
Determine if an item exists in a collection
The following code shows you how to determine if an item exists within a collection.
Option Explicit
'Purpose : Determines if an item already exists in a collection
'Inputs : oCollection The collection to test for the existance of the item
' vIndex The index of the item.
' [vItem] See Outputs
'Outputs : Returns True if the item already exists in the collection.
' [vItem] The value of the item, if it exists, else returns "empty".
'Notes :
'Example :
Function CollectionItemExists(vIndex As Variant, oCollection As Collection, Optional vItem As Variant) As Boolean
On Error GoTo ErrNotExist
'Clear output result
If IsObject(vItem) Then
Set vItem = Nothing
Else
vItem = Empty
End If
If VarType(vIndex) = vbString Then
'Test if item exists
If VarType(oCollection.Item(CStr(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(CStr(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(CStr(vIndex))
End If
Else
'Test if item exists
If VarType(oCollection.Item(Int(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(Int(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(Int(vIndex))
End If
End If
'Return success
CollectionItemExists = True
Exit Function
ErrNotExist:
CollectionItemExists = False
On Error GoTo 0
End Function
'Demonstration routine
Sub Test()
Dim oColl As New Collection, oValue As Variant
oColl.Add "red1", "KEYA"
oColl.Add "red2", "KEYB"
'Return the two items in the collection
Debug.Print CollectionItemExists("KEYA", oColl, oValue)
Debug.Print "Returned: " & oValue
Debug.Print "-----------"
Debug.Print CollectionItemExists(2, oColl, oValue)
Debug.Print "Returned: " & oValue
'Should fail
Debug.Print CollectionItemExists("KEYC", oColl, oValue)
Debug.Print "Returned: " & oValue
Set oColl = Nothing
End Sub
See more at: https://web.archive.org/web/20140723190623/http://visualbasic.happycodings.com/other/code10.html#sthash.MlGE42VM.dpuf
While looking for a function like this i designed it as following.
This should work with objects and non-objects without assigning new variables.
Public Function Exists(ByRef Col As Collection, ByVal Key) As Boolean
On Error GoTo KeyError
If Not Col(Key) Is Nothing Then
Exists = True
Else
Exists = False
End If
Exit Function
KeyError:
Err.Clear
Exists = False
End Function