When I am adding information to the file it does that all and well. It error checks the fields but at the end, adds blank spaces to the file.
This also happens if the fields are kept blank.
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
If Char.IsNumber(txtStudentID.Text) = False Then
MessageBox.Show("Text cannot include letters or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtStudentID.Clear()
txtStudentID.Focus()
Else
OneMember.StudentID = txtStudentID.Text
End If
Char.IsLetter(txtName.Name)
If Char.IsLetter(txtName.Text) = False Then
MessageBox.Show("Text cannot include number or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtName.Clear()
txtName.Focus()
Else
'OneMember.NameOfStudent = txtName.Text
End If
Char.IsLetter(txtLesson.Name)
If Char.IsLetter(txtLesson.Text) = False Then
MessageBox.Show("Text cannot include number or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtLesson.Clear()
txtLesson.Focus()
Else
'OneMember.Lesson = txtLesson.Text
End If
Char.IsNumber(txtPayed.Text)
If Char.IsNumber(txtPayed.Text) = False Then
MessageBox.Show("Text cannot include letters or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtPayed.Clear()
txtPayed.Focus()
Else
OneMember.AmountPayed = txtPayed.Text
End If
OneMember.NameOfStudent = txtName.Text
OneMember.Lesson = txtLesson.Text
OneMember.DOl = txtDate.Text
OneMember.TOL = txtTime.Text
FileOpen(1, AddLesson, OpenMode.Random, , , Len(OneMember))
NumberOfRecords = LOF(1) / Len(OneMember)
FilePut(1, OneMember, NumberOfRecords + 1)
FileClose()
NumberOfRecords = NumberOfRecords + 1
txtStudentID.Clear()
txtName.Clear()
txtDate.Clear()
txtTime.Clear()
txtLesson.Clear()
txtPayed.Clear()
MsgBox(" Student added to file")
End Sub
Related
Inserted my progress bar and it didn't work as expected. When i logged in, it works, but it doesn't automatically loads the second form.
Here is my code for progress/timer
Private Sub Timer1_Timer()
If ProgressBar1.Value = 100 Then
ProgressBar1.Value = 0
Else
ProgressBar1.Value = Val(ProgressBar1.Value) + Val(20)
End If
Label3.Caption = ProgressBar1.Value
Label , to detect 100, variable prg to hold
Private Sub Label3_Change()
If (Label3.Caption = 100) Then
prg = 1
Timer1.Interval = 0
End If
End Sub
log in button
Private Sub cmdSign_Click()
currentTime = TimeValue(Now)
strCurrdate = Format(Date, "mmm d, YYYY")
rx.Open "Select * from login where username ='" & Text1 & "' and password='" & Text2 & "'", db, 3, 3
If (counter = 3) And (rx.EOF = True) Then
MsgBox "You guessed too many times! Intruder alert!"
End
Else
If rx.EOF = True Then
MsgBox "Invalid Username or Password"
counter = counter + 1
Text1 = ""
Text2 = ""
Else
user1 = Text1.Text
logTime = currentTime
rxd.Open "Select * from logHistory", db, 3, 3
With rxd
.AddNew
.Fields("username") = user1
.Fields("TimeDate") = strCurrdate
.Fields("TimeIn") = logTime
.Update
End With
Set rxd = Nothing
'problem might be here
ProgressBar1.Visible = True
Timer1.Interval = 100
Label3.Visible = True
Timer1.Enabled = True
If prg = 1 Then
MsgBox "Welcome " + Text1 + " to SPARTAN!"
mainmenu.Show
End If
End If
End If
Set rx = Nothing
End Sub
Any help on this?
Once the timer is started it runs asynchronously to the rest of your code. The way you have coded your login button you are expecting the timer to move the progressbar from 0 to 100, set your (I assume) module scoped variable prg to 1 and then continue. In reality your code enables the timer and moves on. When it reaches the If prg = 1 Then statement prg is still whatever it has been initialized at. One way to fix it is to check the prg variable in your timer event.
Private Sub Timer1_Timer()
If ProgressBar1.Value = 100 Then
Timer1.Enabled = False ' don't fire the timer event again
ProgressBar1.Value = 0
MsgBox "Welcome " & Text1 & " to SPARTAN!"
mainmenu.Show
Else
ProgressBar1.Value = Val(ProgressBar1.Value) + Val(20)
End If
Label3.Caption = ProgressBar1.Value
End Sub
I also changed your string concatenation + to &. The plus symbol "+" works, but is only included in VB versions after 3 for backward compatibility and it is considered bad form to use it for other than arithmetic. In VB version 4 and greater the ampersand "&" should be used for concatenation. MSDN reference here
You'll have to excuse me for a repeat question but I just can't seem to understand the responses others have been posting. My coding skills are very limited (barely a year in vb 2006 and vs 2010)
I know that the sr has opened too many of the same file but I cant figure out a fix for it. Explaining it to me in simple concepts would be very helpful. Once again sorry for the newby-ness.
Project Explanation: Create a bowling league stats keeper. cmdRegisterBowler adds bowler name to a dat file (bowlers.dat). cmdEnterScores will write name and stats to games.dat file.
Private Sub cmdRegisterBowler_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdRegisterBowler.Click
'BOWLER REGISTRATION
Dim Person As String
Dim Team As String
txtName.Text.ToUpper()
txtTeam.Text.ToUpper()
Person = txtName.Text
Team = txtTeam.Text
If Person <> "" And Team <> "" Then
If IsInFile(Person & " " & Team) = True Then
MessageBox.Show(Person & " is already in the file.", "Error")
txtName.Clear()
txtTeam.Clear()
txtName.Focus()
Else
'swb = stream writer bowlers file
Dim swb As IO.StreamWriter = IO.File.AppendText("bowlers.dat")
swb.WriteLine(Person & " " & Team)
swb.Close()
MessageBox.Show(Person & " has been added to the file.", "Information Added")
txtName.Clear()
txtTeam.Clear()
txtName.Focus()
End If
Else
MessageBox.Show("You must enter a name.", "Information Incomplete")
End If
End Sub
Function IsInFile(ByVal person As String) As String
If IO.File.Exists("bowlers.dat") Then
Dim sr As IO.StreamReader = IO.File.OpenText("bowlers.dat")
Dim individual As String
Do Until sr.EndOfStream
individual = sr.ReadLine
If individual = person Then
Return True
sr.Close()
End If
Loop
sr.Close()
End If
Return False
End Function
Private Sub cmdEnterScores_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEnterScores.Click
'SCORE ENTRY
Dim Person As String
Dim Team As String
Dim Score1 As Double
Dim Score2 As Double
Dim Score3 As Double
Dim Average As Double
Dim Display As String = "{0,-10} {1,10} {2,20} {3,10} {4,10} {5,10} {6,10}"
Dim Total As Double
Person = txtName2.Text
Team = txtTeam2.Text
Score1 = Val(txtFirstGame.Text)
Score2 = Val(txtSecondGame.Text)
Score3 = Val(txtThirdGame.Text)
Total = Score1 + Score2 + Score3
Average = Total / 3
Dim swb As IO.StreamWriter = IO.File.AppendText("bowlers.dat")
'Checks for blank entries
If Person <> "" Then
'Checks to see if person is registered
If IsNotInFile(Person) Then
Dim Response As Integer
' Displays a message box with the yes and no options to register bowler.
Response = MsgBox(Prompt:="The bowler you have entered is currently not registered. Would you like to do so?", Buttons:=vbYesNo)
'Yes button was selected. Bowler is then registered to bowlers.dat
If Response = vbYes Then
''swb = stream writer bowlers file
swb.WriteLine(Person & " " & Team)
swb.Close()
MessageBox.Show(Person & " has been added to the file.", "Information Added")
'The no button was selected. Focus is set to bowler registration group box
Else : Response = vbNo
txtName2.Clear()
txtTeam2.Clear()
txtFirstGame.Clear()
txtSecondGame.Clear()
txtThirdGame.Clear()
txtName.Focus()
End If
'If no then clears score entry group box and sets focus back to bowler registr
txtName.Clear()
txtName.Focus()
Else
'Write scores to games.dat file
'swg = stream writer games file
Dim swg As IO.StreamWriter = IO.File.AppendText("games.dat")
swg.WriteLine(Name & " " & Team & " " & Score1 & " " & Score2 & " " & Score3)
swg.Close()
MessageBox.Show(Person & "'s stats added to the file.", "Information Added")
txtName.Clear()
txtName.Focus()
Dim Display2 As String = "{0,-10} {1,10} {2,20} {3,10} {4,10} {5,10} {6,10}"
lstDisplay.Items.Add(String.Format(Display2, Person, Team, Score1, Score2, Score3, Total, Average))
End If
Else
MessageBox.Show("You must enter a name.", "Information Incomplete")
End If
End Sub
Function IsNotInFile(ByVal person As String) As String
If IO.File.Exists("bowlers.dat") Then
Dim sr As IO.StreamReader = IO.File.OpenText("bowlers.dat")
Dim individual As String
Do Until sr.EndOfStream
individual = sr.ReadLine
If individual <> person Then
Return True
sr.Close()
End If
Loop
sr.Close()
End If
Return False
End Function
Heres all my code. Thanks for any help in advance.
I haven't used Visual Basic in quite a while, but I believe the solution is simple.
Basically, your interactions with the System.IO library are currently very optimistic. You should always wrap IO interactions within a TRY...CATCH...END TRY block.
Check it out here: MSDN Example of StreamReader.ReadLine
To illustrate more clearly my meaning, I've altered one of your functions here:
Function IsInFile(ByVal person As String) As String
Try
If IO.File.Exists("bowlers.dat") Then
Dim sr As IO.StreamReader = IO.File.OpenText("bowlers.dat")
Dim individual As String
Do Until sr.EndOfStream
individual = sr.ReadLine
If individual = person Then
Return True
sr.Close()
End If
Loop
sr.Close()
End If
Return False
Catch ie as IOException
MessageBox.Show("Failed to search for " & person & " in file.", "Error")
Return false
End Try
End Function
I'd apply similar logic to surround all your interactions with Files within your code. I'd also recommend against using MessageBox to report errors -- it's okay for small projects, but for anything larger you're going to want to look up using a logging framework. Or build a debug console into your application that you can selective turn on or off via configuration.
I put three items in a listview and checkboxes to choose one of them at time. The code works if I check the items from the first to the last but it doesn't when and go backwards. I mean, after choosing the last item if I choose again the second the message shown is wrong. How can fix it?
Cheers.
For Each Me.item In lsv_school.Items
If Not item.Index = e.Index Then
item.Checked = False
If e.Index = lsv_school.Items(0).Checked Then
lbl_err.Hide()
lbl_feed.Text = "Your school tuition will be " + "$" & dipAcc + " per term."
ElseIf e.Index = lsv_school.Items(1).Checked Then
lbl_err.Hide()
lbl_feed.Text = "Your school tuition will be " + "$" & dipBus + " per term."
ElseIf e.NewValue = lsv_school.Items(2).Checked Then
lbl_err.Hide()
lbl_feed.Text = "Your school tuition will be " + "$" & dipMar + " per term."
End If
End If
Next
End Sub
I solved the mess by myself, thanks for your suggestions but I had to use those components and could not do otherwise. I will post the code I used.
The first sub class is a loop to check one checkbox at time.
Private Sub lsv_school_ItemCheck(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemCheckEventArgs) Handles lsv_school.ItemCheck
'Loop to check one checkbox at time.
For Each Me.item In lsv_school.Items
If Not item.Index = e.Index Then
item.Checked = False
End If
Next
End Sub
The second sub class solve the problem, the conditional statements now check each case properly.
Private Sub lsv_school_ItemChecked(ByVal sender As Object, ByVal e As ItemCheckedEventArgs) Handles lsv_school.ItemChecked
'Conditional statements to select one course at time.
If lsv_school.Items(0).Checked = True Then
item.Selected = CBool(dipAcc)
lbl_err.Hide()
lbl_feed.Show()
lbl_feed.Text = "Your school tuition will be " + "$" & dipAcc
ElseIf lsv_school.Items(1).Checked = True Then
item.Selected = CBool(dipBus)
lbl_err.Hide()
lbl_feed.Show()
lbl_feed.Text = "Your school tuition will be " + "$" & dipBus
ElseIf lsv_school.Items(2).Checked = True Then
item.Selected = CBool(dipMar)
lbl_err.Hide()
lbl_feed.Show()
lbl_feed.Text = "Your school tuition will be " + "$" & dipMar
Else
If item.Checked = False Then
lbl_feed.Text = ""
lbl_feed.Hide()
lbl_err.Show()
lbl_err.Text = "Select a course from the list."
End If
End If
End Sub
In this way I managed to let checkboxes work as radiobuttons inside a listview.
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 am new to VBA and my problem might be stupid, but I cant fix it, so please help me if you can!
Here is the thing: I got userform that fills spreadsheet perfectly, but if information is not entered it does crazy things. As you may see below i found some piece of code to check if the data is entered, so if its not window pops up and you have to enter something, but when you do form fills 2 rows of data instead of one. For example, if pick row 'x' and want to put values 'a','b','c','d', but forgot to put value 'c' then it shows an error and when i type missing value 'c' and press OK it creates row 'x' with values 'a','b',' ','d' and row 'x+1' with values 'a','b','c','d'.
Here is my code:
Private Sub cmdok_Click()
'next empty cell in column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task
'write userform entries to database
c.Value = Me.txtFname.Value
c.Offset(0, 3).Value = Me.txtngoals.Value
c.Offset(0, 28).Value = Me.cmbDiag.Value
If Me.optAcute.Value = "True" And Me.optchronic.Value = "False" Then
c.Offset(0, 29).Value = 1
c.Offset(0, 30).Value = ""
Else
c.Offset(0, 29).Value = ""
c.Offset(0, 30).Value = 1
End If
'input validation
If txtFname.Value = "" Then
MsgBox ("Sorry, you need to provide a Name")
txtFname.SetFocus
Exit Sub
End If
If txtngoals.Value = "" Then
MsgBox ("Sorry, you need to provide goals")
txtngoals.SetFocus
Exit Sub
End If
If cmbDiag.Value = "" Then
MsgBox ("Sorry, you need to provide Diagnosis")
cmbDiag.SetFocus
Exit Sub
End If
If optAcute.Value = optchronic.Value Then
MsgBox ("Sorry, you need to select Time since injury")
Exit Sub
End If
'clear the form
With Me
.txtFname.Value = vbNullString
.cmbDiag.Value = vbNullString
.optAcute.Value = vbNullString
.optchronic.Value = vbNullString
.txtngoals.Value = vbNullString
End With
Application.ScreenUpdating = True
End Sub
thank you in advance
Try moving the code "write userform entries to database" to after the validation checks.
Private Sub cmdok_Click()
'next empty cell in column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task
'input validation
If txtFname.Value = "" Then
MsgBox ("Sorry, you need to provide a Name")
txtFname.SetFocus
Exit Sub
End If
If txtngoals.Value = "" Then
MsgBox ("Sorry, you need to provide goals")
txtngoals.SetFocus
Exit Sub
End If
If cmbDiag.Value = "" Then
MsgBox ("Sorry, you need to provide Diagnosis")
cmbDiag.SetFocus
Exit Sub
End If
If optAcute.Value = optchronic.Value Then
MsgBox ("Sorry, you need to select Time since injury")
Exit Sub
End If
'write userform entries to database
c.Value = Me.txtFname.Value
c.Offset(0, 3).Value = Me.txtngoals.Value
c.Offset(0, 28).Value = Me.cmbDiag.Value
If Me.optAcute.Value = "True" And Me.optchronic.Value = "False" Then
c.Offset(0, 29).Value = 1
c.Offset(0, 30).Value = ""
Else
c.Offset(0, 29).Value = ""
c.Offset(0, 30).Value = 1
End If
'clear the form
With Me
.txtFname.Value = vbNullString
.cmbDiag.Value = vbNullString
.optAcute.Value = vbNullString
.optchronic.Value = vbNullString
.txtngoals.Value = vbNullString
End With
Application.ScreenUpdating = True