In code [VB6], I'm searching in a collection for a specific data. Fam87 comes from a text file.
Function cumplefam(Fam87FO As String, rFamn1 As String, rFamn2 As String, rFam87 As String) As Boolean
Dim objfam As Tfamilias
Dim c1, c2, c3 As String
**objfam = getfamilia(Fam87FO)**
If rFamn1 = "" Then
c1 = "OK"
Else
If InStr(objfam.cFamn1, rFamn1) > 0 Then
c1 = "OK"
Else
c1 = "NO OK"
End If
End If
If rFamn2 = "" Then
c2 = "OK"
Else
If InStr(objfam.cFamn2, rFamn2) > 0 Then
c2 = "OK"
Else
c2 = "NO OK"
End If
End If
If rFam87 = "" Then
c3 = "OK"
Else
If InStr(objfam.cFam87, rFam87) > 0 Then
c3 = "OK"
Else
c3 = "NO OK"
End If
End If
If c1 = "OK" And c2 = "OK" And c3 = "OK" Then
cumplefam = True
Else
cumplefam = False
End If
End Function
The problem comes when getfamilia runs:
Function getfamilia(cFam As String) As Tfamilias
On Error Resume Next
Set getfamilia = Nothing
getfamilia = colfamilias(cFam)
End Function
Running it step-by-step does give me the data I want, but when it hits the End Function it shows:
Run-time error '91': Object variable or With block variable not set
I'm inexperienced in VB, so I don't really catch what my error is here.
Assuming that colfamilias has actually been initialized, for a return value that is an object, you must use Set:
Function getfamilia(cFam As String) As Tfamilias
On Error Resume Next
Set getfamilia = Nothing
Set getfamilia = colfamilias(cFam) '// change this line
End Function
And in your call to the function:
Set objfam = getfamilia(Fam87FO)
Related
What is the quickest and easiest way (in Classic ASP) to check if a string has some string (that has a length greater than 0) i.e. NOT "Null", "Nothing", "Empty", or '' empty string
To make sure that the Variant you deal with is of sub-type "string", you need the VarType or TypeName function. To rule out zero length strings, you need Len(). To guard against strings of space, you could throw in a Trim().
Code to illustrate/experiment with:
Option Explicit
Function qq(s) : qq = """" & s & """" : End Function
Function toLiteral(x)
Select Case VarType(x)
Case vbEmpty
toLiteral = "<Empty>"
Case vbNull
toLiteral = "<Null>"
Case vbObject
toLiteral = "<" & TypeName(x) & " object>"
Case vbString
toLiteral = qq(x)
Case Else
toLiteral = CStr(x)
End Select
End Function
Function isGoodStr(x)
isGoodStr = False
If vbString = VarType(x) Then
If 0 < Len(x) Then
isGoodStr = True
End If
End If
End Function
Dim x
For Each x In Array("ok", "", " ", 1, 1.1, True, Null, Empty, New RegExp)
WScript.Echo toLiteral(x), CStr(isGoodStr(x))
Next
output:
cscript 26107006.vbs
"ok" True
"" False
" " True
1 False
1.1 False
True False
<Null> False
<Empty> False
<IRegExp2 object> False
Here's a one-liner that dodges all the trouble with Null by concatenating the value with an empty string. It works for Null, Empty, "", and, of course, strings with actual length! The only one it doesn't (nor shouldn't) work for is Nothing, because that's for object variables, of which a string is not.
isNullOrEmpty = (Len("" & myString) = 0)
You could try having something like this:
Function nz(valToCheck, valIfNull)
If IsNull(valToCheck) then
nz = valIfNull
Else
nz = valToCheck
End if
End function
and then you would use it like this:
if nz(var,"") <> "" then
'--string has something in it
else
'--string is null or empty
end is
You can use the VarType() function to check if it is a string, then you can check if the string is not empty. This statement will only pass through a string that isn't empty.
If VarType(MyString) = 8 Then
If MyString <> "" Then
'String is Not Null And Not Empty, code goes here
End If
End If
This worked for me:
if mystring = "" then wscript.echo "Empty string"
else wscript.echo "String is not empty"
<%
Dim x,y
x = "abcdefg"
'counting length of string
y = Len(x)
Response.Write (y)
'checking string is empty or not
If Len(x) = 0 then
Response.Write ("<p>String is empty</p>")
Else
Response.Write ("<p>String is not empty</p>")
End If
%>
Hope this is helpful.
I have a2 richtext box first one called a1 second one b2 . Both of them have texts
What im trying to do is : delete any line that a2 has from b2
So if a2 contain lines
First line = 1256
Second one = 5678
....etc
I want to remove any line in b2 that contain this lines in a2 1256 and 5678 ..etc
I tried to use filter but that took long time because there are alot of lines and didnt work
I tried to solve your problem so i reached to this(it's not completely what you want but it may help you) :
Public Class Form1
Dim CheckChar, CheckedChar As String
Dim CheckedNum As Integer = 1
Private Sub CheckBUT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBUT.Click
If Not a1.Text = "" Then
If a1.Text.Length > 2 Then
ReRead: If CheckedNum = 1 Then
CheckChar = a1.Text.Remove(1)
Else
CheckChar = a1.Text.Substring(CheckedNum - 1)
If Not CheckedNum = a1.Text.Length Then
CheckChar = CheckChar.Remove(1)
End If
End If
If CheckChar.Contains("" & vbLf & "") Then
CheckedChar = a1.Text.Remove(CheckedNum - 1)
CheckChar = b2.Find(CheckedChar)
If Not CheckChar = -1 Then
b2.Text = b2.Text.Replace(CheckedChar & ("" & vbLf & ""), "")
End If
Else
a1.Text.Substring(CheckedNum - 1)
End If
If CheckedNum = a1.Text.Length Then
CheckedNum = 1
Else
CheckedNum = CheckedNum + 1
GoTo ReRead
End If
End If
End If
End Sub
End Class
I Hope The Code was Useful to You
I'm new to vb and trying to figure things out via searching the net or asking colleagues but now I hit a dead end. I want to have my program to make sure that all my textboxes are filled before saving into the db.
Here is my code:
Private Sub CmdSave_Click()
Set rs = New ADODB.Recordset
With rs
.Open "Select * from table1", cn, 2, 3
If LblAdd_Edit.Caption = "ADD" Then
If MsgBox("Do you want to save this new rocord?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
.AddNew
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Else
If MsgBox("Do you want to save this changes?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
Do While Not .EOF
If LvList.SelectedItem.Text = !Type Then
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Exit Do
Else
.MoveNext
End If
Loop
End If
End With
Form_Activate
Save_Cancel
End Sub
I was trying to add the following
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
MsgBox("All Fields Required", vbCritical, "Error") = vbOK: Exit Sub
When I run the program I get a compile error
function or call on the left-hand side of assignment must return a variant or object. I use that msgbox function all the time but now its the line I get an error
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
If MsgBox("All Fields Required", vbCritical, "Error") = vbOK Then Exit Sub
Here is a generic solution. It uses a function to check each textbox on the form and demonstrates using the function. I also compare the text length rather than the text to an empty string because (in general) numeric comparisons are faster than string comparisons.
Private Sub Command1_Click()
If ValidateTextFields Then
MsgBox "Your changes have been saved."
Else
MsgBox "All fields are required."
End If
End Sub
Private Function ValidateTextFields() As Boolean
Dim ctrl As Control
Dim result As Boolean
result = True 'set this to false if a textbox fails
For Each ctrl In Me.Controls
If TypeOf ctrl Is TextBox Then
If Len(ctrl.Text) = 0 Then
result = False
Exit For 'bail on the first failure
End If
End If
Next ctrl
ValidateTextFields = result
End Function
In VB6, you can use Trim() function so that spaces not considered as characters.
If (Trim$(txtGOSID.Text) = "") Then
msgBox "Please provide input.", vbExclamation
With the $ sign, Trim() returns a String value directly; without the $
sign, Trim() returns a Variant with a sub-type of String.
I don't want to edit some of the column in flex gird.
Flex Grid
column1, column2, .... column35
i want to edit from column1... column10 only, remaining columns i don't want to edit or type.
How to do in vb6.
I believe the MS Flex Grid was designed for displaying data and not editing. If you need to edit cell data you can accomplish it using the Flex Grid using an approach of superimposing a textbox at runtime to capture user data entry and set the "Text" property of the cell in code. Otherwise you can choose to use a different control.
Here are some examples of the aforementioned approach:
http://support.microsoft.com/kb/241355
http://www.vb-helper.com/howto_edit_flexgrid_control.html
I've made a special user control in VB6 to an editable grid. If you want I can send you a copy.
The code I use to enable to edit a cell is the follow:
Private Sub fg_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Cancel As Boolean
Dim Idc As Long
Dim x
If KeyCode = vbKeyEscape And Shift = 0 Then
If Not fgLocked Then
If fgRowChanged Then
RaiseEvent BeforeRestoreBuffer
For Idc = 1 To UBound(fgBuffer)
x = fgBuffer(Idc)
fgValues(Idc, fg.Row) = x
If fgColFormat(Idc) = "*" And fgBuffer(Idc) <> "" Then
fg.TextMatrix(fg.Row, Idc) = "*******"
ElseIf fgColFormat(Idc) = "RTF" Then
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), "")
Else
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), fgColFormat(Idc))
End If
Next
fgRowChanged = False
RaiseEvent RestoreBuffer
End If
End If
ElseIf KeyCode = vbKeyReturn And Shift = 0 Then
NextCell
ElseIf KeyCode = vbKeyF2 And Shift = 0 Then
If Not fgLocked Then
If fgColFormat(fg.Col) = "RTF" Then
CellEditBig fgValues(fg.Col, fg.Row)
Else
CellEdit fgValues(fg.Col, fg.Row)
End If
End If
ElseIf KeyCode = vbKeyF2 And Shift = vbShiftMask Then
If Not fgLocked Then
CellEditBig fgValues(fg.Col, fg.Row)
End If
ElseIf KeyCode = vbKeyDelete And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeDelete(Cancel)
If Not Cancel Then
If fg.Rows = fg.FixedRows + 1 Then
fg.AddItem ""
If fgRowNumber Then fg.TextMatrix(fg.Rows - 1, 0) = fg.Rows - 1
fgValues_AddItem ""
End If
fg.RemoveItem fg.Row
If fgRowNumber Then Renumera
fgValues_RemoveItem fg.Row
LoadBuffer fg.Row
RaiseEvent AfterDelete
End If
End If
ElseIf KeyCode = vbKeyInsert And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeInsert(Cancel)
If Not Cancel Then
fg.AddItem "", fg.Row
If fgRowNumber Then Renumera
fgValues_AddItem "", fg.Row
RaiseEvent AfterInsert
End If
End If
Else
RaiseEvent KeyDown(KeyCode, Shift)
End If
End Sub
I'm building a VB application that accepts numbers in the beginning. I want to be able to exit if the user presses the cancel button in any of the input boxes.
The code is :
Private Sub Command1_Click()
Dim a, b, c, d As Integer
Dim response As Integer
Dim a1, b1, c1, d1 As String
a = InputBox("Enter Numerator 1")
b = InputBox("Enter Denominator 1")
c = InputBox("Enter Numerator 2")
d = InputBox("Enter Denominator 2")
a1 = Str(a)
b1 = Str(b)
c1 = Str(c)
d1 = Str(d)
If a1 <> "" And b1 <> "" And c1 <> "" And d1 <> "" Then
'All Actions
...
Else
response = MsgBox("Are you sure you want to quit?", vbYesNo + vbQuestion, AdditionV1.0")
If response = vbYes Then
End
Else
Addition.Show
End If
I've tried using StrPtr and it stil doesnt work. What happens is even if I press Cancel, it still displays the error message.
Help will really be appreciated.
StrPtr is the way to go. Since you didn’t show the relevant code, there is no telling what you did wrong (but there are several errors in the code anyway). In principle, the following works:
Dim a As String
a = InputBox("Enter Numerator 1")
If StrPtr(a) = 0 Then
' Nothing was entered.
End If
I suspect that you applied the check to a1 etc. instead of the original variables. Not only does this not work (Str forces the string to be non-null), it also makes no sense: what are those variables for, anyway?
Furthermore, all your variable declarations are wrong. The following:
Dim a, b, c, d As Integer
declares a, b and c as Variant. Only d will be an Integer. For this, and for other reasons (readability), never declare multiple variables in one statement. Always declare them separately. Oh, and use meaningful names. a, b, c, d aren’t helpful.
If I understand your question correctly, you want to stop processing the moment user presses a cancel button.
I would suggest doing something like this (Note that I changed the variables to a1, b1,c1,d1 of assignment from InputBox):
Private Sub Command1_Click()
Dim a, b, c, d As Integer
Dim response As Integer
Dim a1, b1, c1, d1 As String
a1 = InputBox("Enter Numerator 1")
if (a1 = "")
exit sub
endif
b1 = InputBox("Enter Denominator 1")
if (b1 = "")
exit sub
endif
c1 = InputBox("Enter Numerator 2")
if (c1 = "")
exit sub
endif
d1 = InputBox("Enter Denominator 2")
if (d1 = "")
exit sub
endif
If a1 <> "" And b1 <> "" And c1 <> "" And d1 <> "" Then
'All Actions
...
Else
response = MsgBox("Are you sure you want to quit?", vbYesNo + vbQuestion, AdditionV1.0")
If response = vbYes Then
End
Else
Addition.Show
End If