Hi all,
I am trying to error check a piece of code and hope someone can help.
This is from my previous thread which 'Codeoder' help me on..
http://www.daniweb.com/software-development/vbnet/threads/403994/1725770#post1725770
I have a RTB which I import with a set of 7 or 9 didit numbers, 7 for Staff and 9 for Students. e.g. Staff numbers
0628189
0628191
0629991
0629850
0804930
and depending on what is selected in a list box ('Student' or 'Staff') will generate a string to create user accounts. To further error check I would like to check if a line in the RTB = 7 And Listbox = "Student" Then msgbox("Data mismatch between User ID and Account type") Else .....
I have error checked and it works if I input 6 and 8 digits prefixing with a 0.
Now the problem is if there is a mix of say 6 and 7 digits. if the first line has 7 digits it still get a prefixed 0. This caused problems when I tried it 'live' and created a new user account with the wrong user ID.
Code as follows:
Public Class FrmLTAD
Dim da As New OleDb.OleDbDataAdapter
Dim con As New OleDb.OleDbConnection
Dim ds As New DataSet
Dim userFullName As String
Dim LogW As String
Dim LogPath As String
Dim PathStr As String
Dim TxtPath As String
Dim ResultsSav As String
Dim dbProvider As String
Dim dbSource As String
DIm itm As String
Dim sql As String
Dim inc As Integer
Dim MaxRows As Integer
Private arTemp() As String = Nothing '// used to get all lines from TextBox.
Private sTemp As String = Nothing '// used to add lines back to TextBox.
Private Sub ButExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButExit.Click
Me.Close()
End Sub
Private Sub FrmLTAD_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.SchYearTableAdapter.Fill(Me.LTADADS.SchYear)
Me.SchCodesTableAdapter.Fill(Me.LTADADS.SchCodes)
ButCutPaste.Visible = False
'log time and user logon name to log file
userFullName = System.Environment.UserName
LogPath = "C:\LTAD\LTAD Log\LTAD.Log"
PathStr = "C:\LTAD\Database\"
LogW = "User " & userFullName & " logged in at " & Date.Now & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
End Sub
Private Sub ClearForm()
Select Case con.State
Case ConnectionState.Open
con.Close() 'already opened? then close
End Select
inc = 0
RTBUserID.Clear()
RTBForename.Clear()
RTBSurname.Clear()
RTBID.Clear()
TxtRefNum.Clear()
TxtResults.Clear()
CBSchName.SelectedIndex = 0
CBSchYear.SelectedIndex = 0
ButCutPaste.Visible = False
End Sub
Private Sub ButClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButClear.Click
TxtRefNum.BackColor = Color.White
RTBUserID.BackColor = Color.White
RTBForename.BackColor = Color.White
RTBSurname.BackColor = Color.White
RTBUserID.Clear()
RTBForename.Clear()
RTBSurname.Clear()
RTBID.Clear()
TxtRefNum.Clear()
TxtResults.Clear()
CBSchName.SelectedIndex = 0
CBSchYear.SelectedIndex = 0
ButCutPaste.Visible = False
Select con.State
Case ConnectionState.Open
con.Close() 'already opened? then close
End Select
Try
Catch ex As DataException
LogW = "User " & userFullName & " Exception error during dataset clear " & Date.Now & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = "--------------------- Exception Message Start ---------------------" & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = ex.Message.ToString & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = "---------------------- Exception Message End ----------------------" & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
MsgBox("Exception error caught, please check logfile", MessageBoxIcon.Error)
End Try
End Sub
Private Sub RadAdd_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadAdd.CheckedChanged
RTBUserID.Enabled = True
RTBForename.Enabled = True
RTBSurname.Enabled = True
End Sub
Private Sub RadMove_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadMove.CheckedChanged
RTBUserID.Enabled = True
RTBForename.Enabled = False
RTBSurname.Enabled = False
End Sub
Private Sub RadDelete_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadDelete.CheckedChanged
RTBUserID.Enabled = True
RTBForename.Enabled = False
RTBSurname.Enabled = False
End Sub
Private Sub RadPassword_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadPassword.CheckedChanged
RTBUserID.Enabled = True
RTBForename.Enabled = False
RTBSurname.Enabled = False
End Sub
Private Function validateCoolRTB(ByVal RTBUserID As RichTextBox, ByVal iIDlengthThatIsAlsoCooLxD As Integer) As Boolean
TxtVal.Text = ""
For Each itm As String In RTBUserID.Lines '// loop thru
If Not itm.Length = iIDlengthThatIsAlsoCooLxD Then TxtVal.Text = itm.Length Else Return False
Next
Return True
End Function
Private Sub CheckClientID()
Dim NumVal As Integer
For x As Integer = 0 To RTBUserID.Text.Length - 1
RTBUserID.SelectionStart = x
RTBUserID.SelectionLength = 1
RTBUserID.Text = RTBUserID.Text.Replace(vbTab, "")
Next
If RTBUserID.Text = "" Then
MsgBox("Please add Client ID's", MessageBoxIcon.Error)
Exit Sub
ElseIf RTBUserID.Text.Substring(0, 1) = vbLf Then
RTBUserID.Text = RTBUserID.Text.Substring(1, RTBUserID.TextLength - 1)
End If
NumVal = 0
If validateCoolRTB(RTBUserID, 6) = False Then
NumVal = 6
ElseIf validateCoolRTB(RTBUserID, 7) = False Then
NumVal = 7
ElseIf validateCoolRTB(RTBUserID, 8) = False Then
NumVal = 8
ElseIf validateCoolRTB(RTBUserID, 9) = False Then
NumVal = 9
End If
Select Case NumVal
Case 6 To 7 And CBSchYear.Text = "Staff"
If NumVal = 7 And CBSchYear.Text = "Staff" Then
Dim arr() As String
Dim i As Integer
arr = Split(RTBUserID.Text, vbCrLf)
For i = 0 To i
RTBID.Text = arr(i)
Next i
Dim f As String = ""
For Each line As String In RTBID.Lines
f &= ZeroPad(line, 7) & vbCrLf
Next
RTBID.Text = f
Else
' ------- working here ------ mixed user id with 7 digit in 1st line gets prefixed with a 0 if there is a mix of 6 and 7 digits.
' need to strip it off.
Dim arr() As String
Dim i As Integer
Dim s As Integer = i.ToString.PadLeft(7).Replace(" ", "0")
arr = Split(RTBUserID.Text, vbCrLf)
For i = 0 To i
RTBID.Text = s & arr(i)
Next i
Dim f As String = ""
For Each line As String In RTBID.Lines
f &= ZeroPad(line, 7) & vbCrLf
Next
RTBID.Text = f
End If
Case 6 To 7 And CBSchYear.Text <> "Staff"
MsgBox("The Staff ID's do not match the school year selected", MessageBoxIcon.Warning)
Exit Sub
Case 8 To 9 And CBSchYear.Text <> "Staff"
If NumVal = 9 And CBSchYear.Text <> "Staff" Then
Dim arr() As String
Dim i As Integer
RTBUserID.Text.TrimEnd(" ")
arr = Split(RTBUserID.Text, vbCrLf)
For i = 0 To i
RTBID.Text = arr(i)
Next i
Dim f As String = ""
For Each line As String In RTBID.Lines
f &= ZeroPad(line, 9) & vbCrLf
Next
RTBID.Text = f
Else
Dim arr() As String
Dim i As Integer
Dim s As Integer = i.ToString.PadLeft(9).Replace(" ", "0")
RTBUserID.Text.TrimEnd(" ")
arr = Split(RTBUserID.Text, vbCrLf)
For i = 0 To i
RTBID.Text = s & arr(i)
Next i
Dim f As String = ""
For Each line As String In RTBID.Lines
f &= ZeroPad(line, 9) & vbCrLf
Next
RTBID.Text = f
End If
Case 8 To 9 And CBSchYear.Text = "Staff"
MsgBox("The Student ID's do not match the school year selected", MessageBoxIcon.Warning)
Exit Sub
End Select
End Sub
Private Function ZeroPad(ByVal num As Integer, ByVal width As Integer) As String
Return num.ToString.PadLeft(width).Replace(" ", "0")
End Function
Private Function ZeroPad(ByVal str As String, ByVal width As Integer) As String
Return str.PadLeft(width).Replace(" ", "0")
End Function
Private Sub ButGenerate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButGenerate.Click
'error check to see if fields are filled in
TxtRefNum.BackColor = Color.White
RTBUserID.BackColor = Color.White
RTBForename.BackColor = Color.White
RTBSurname.BackColor = Color.White
Dim txt() As TextBox = {TxtRefNum}
Dim i As Integer = 0
Dim flag As Integer = 0
While i < txt.Length
If txt(i).Text = String.Empty Then
txt(i).BackColor = Color.LightCoral
flag = 1
End If
i += 1
End While
If flag Then
MsgBox("Please add the LanDesk the Ref number")
Exit Sub
End If
'log time and user logon name to log file
userFullName = System.Environment.UserName
LogPath = "C:\LTAD\LTAD Log\LTAD.Log"
PathStr = "C:\LTAD\Database\"
LogW = "User " & userFullName & " logged in at " & Date.Now & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
' Check for prefixed character is uppercase
Dim refNum As String = StrConv(TxtRefNum.Text, VbStrConv.ProperCase)
TxtRefNum.Text = refNum
'sets up path for database
dbProvider = "Provider=Microsoft.ACE.OLEDB.12.0; "
dbSource = "Data Source = " & PathStr & "LTADAccounts.accdb;"
con.ConnectionString = dbProvider & dbSource
con.Open()
If inc <> -1 Then
Dim LanRef, SchName, SchYear, Category, sqlInsert As String
Dim DCreated As Date
Dim TotalNo As Integer
Dim result As Integer = -1
Dim SqlCommand As OleDb.OleDbCommand = New OleDb.OleDbCommand
Dim myConnection = New OleDb.OleDbConnection()
LanRef = TxtRefNum.Text
DCreated = Date.Now().ToString("d")
SchName = CBSchName.Text.Trim
SchYear = CBSchYear.Text.Trim
If RadAdd.Checked = True And RTBUserID.Text <> "T" And RTBUserID.Text <> "t" And RTBUserID.Text <> "C" And RTBUserID.Text <> "c" Then
Category = "Add"
CheckClientID()
CreateAdd()
ElseIf RadAdd.Checked = True And RTBUserID.Text = "T" Or RTBUserID.Text = "t" Then
CreateTrainee()
ElseIf RadAdd.Checked = True And RTBUserID.Text = "C" Or RTBUserID.Text = "c" Then
CreateContractor()
ElseIf RadDelete.Checked = True Then
Category = "Delete"
CheckClientID()
CreateDelete()
ElseIf RadMove.Checked = True Then
Category = "Move"
CheckClientID()
CreateMove()
ElseIf RadPassword.Checked = True Then
Category = "Password"
CheckClientID()
CreatePass()
End If
If RTBUserID.Text = "" Then
RTBUserID.BackColor = Color.LightCoral
MsgBox("Please add Client ID's", MessageBoxIcon.Error)
Exit Sub
ElseIf RTBUserID.Text.Substring(0, 1) = vbLf Then
RTBUserID.Text = RTBUserID.Text.Substring(1, RTBUserID.TextLength - 1)
End If
TotalNo = RTBUserID.Lines.Count() - 1
sqlInsert = "INSERT INTO Log (LanDeskNo, SchName, YearCode, Category, TotalNumber, DateCreated, CreatedBy)" &
"VALUES ('" & LanRef & "','" & SchName & "','" & SchYear & "','" & Category & "','" & TotalNo & "','" & DCreated & "','" & userFullName & "')"
Try
SqlCommand.Connection = con
SqlCommand.CommandText = sqlInsert
result = SqlCommand.ExecuteNonQuery()
Catch ex As DataException
LogW = "User " & userFullName & " Exception error during insert " & Date.Now & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = "--------------------- Exception Message Start ---------------------" & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = ex.Message.ToString & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
LogW = "---------------------- Exception Message End ----------------------" & vbCrLf
My.Computer.FileSystem.WriteAllText(LogPath, LogW, True)
MsgBox("Exception error caught, please check logfile", MessageBoxIcon.Error)
End Try
result = -1
End If
con.Close()
ButCutPaste.Visible = True
End Sub
Private Function removeLines(ByVal textInLineToFind As String, ByVal selectedTextBox As TextBox) As String
arTemp = selectedTextBox.Lines '// set all lines from TextBox into a String Array.
sTemp = "" '// clear for new input.
For Each txtLine As String In arTemp '// loop thru all arrays.
If Not txtLine.Contains(textInLineToFind) Then '// check for line that contains preselected text and skip if .Contains.
'// if not in line, add to string.
If Not sTemp = "" Then sTemp &= vbNewLine & txtLine Else sTemp = txtLine
End If
Next
Return sTemp '// return text back to TextBox.
End Function
Private Sub RemoveBlankLine()
If RTBUserID.Text.Length > 0 Then
Dim lines(RTBUserID.Lines.Length - 2) As String
Array.Copy(RTBUserID.Lines, lines, RTBUserID.Lines.Length - 1)
RTBUserID.Lines = lines
End If
End Sub
Private Sub CreateTrainee()
Dim SecondBox() As String = RTBForename.Lines
Dim ThirdBox() As String = RTBSurname.Lines
For i = 0 To UBound(SecondBox)
TxtResults.Text &= TxtSchCode.Text & "," & "T" & "," & TxtSchYear.Text & "," & SecondBox(i).TrimEnd & " " & ThirdBox(i).TrimEnd & ",,,," & TxtRefNum.Text & vbCrLf
Next
TxtResults.Text = removeLines(", ,,,,", TxtResults)
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub CreateContractor()
Dim SecondBox() As String = RTBForename.Lines
Dim ThirdBox() As String = RTBSurname.Lines
For i = 0 To UBound(SecondBox)
TxtResults.Text &= TxtSchCode.Text & "," & "C" & "," & TxtSchYear.Text & "," & SecondBox(i).TrimEnd & " " & ThirdBox(i).TrimEnd & ",,,," & TxtRefNum.Text & vbCrLf
Next
TxtResults.Text = removeLines(", ,,,,", TxtResults)
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub CreateAdd()
Me.RTBID.Lines = Me.RTBID.Text.Split(New Char() {ControlChars.Lf}, StringSplitOptions.RemoveEmptyEntries)
Dim FirstBox() As String = RTBID.Lines
Dim SecondBox() As String = RTBForename.Lines
Dim ThirdBox() As String = RTBSurname.Lines
If FirstBox.Count <> SecondBox.Count Then
MsgBox("Data mismatch - Client ID Count = " & FirstBox.Count & " Forename Count = " & SecondBox.Count)
Exit Sub
End If
For i = 0 To UBound(FirstBox)
TxtResults.Text &= TxtSchCode.Text & "," & FirstBox(i).Trim & "," & TxtSchYear.Text & "," & SecondBox(i).TrimEnd & " " & ThirdBox(i).TrimEnd & ",,,," & TxtRefNum.Text & vbCrLf
Next
'Remove Last Line if it contains 000000000 in the Client ID
If CBSchYear.Text = ("Staff") Then
TxtResults.Text = removeLines("000000", TxtResults)
Else
TxtResults.Text = removeLines("000000000", TxtResults)
End If
'Search for the first two characters in the client ID being 00 and strips one off.
TxtResults.Text = TxtResults.Text.Replace(TxtSchCode.Text & ",00", TxtSchCode.Text & ",0")
'strips off blank line
If TxtResults.Text.Length > 0 Then
Dim lines(TxtResults.Lines.Length - 2) As String
Array.Copy(TxtResults.Lines, lines, TxtResults.Lines.Length - 1)
TxtResults.Lines = lines
End If
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub CreateDelete()
Dim FirstBox() As String = RTBID.Lines
For i = 0 To UBound(FirstBox)
TxtResults.Text &= TxtSchCode.Text & "," & FirstBox(i).TrimEnd & "," & TxtSchYear.Text & ",deleteme,,,," & TxtRefNum.Text & vbCrLf
Next
'Remove Last Line if it contains 000000000 in the Client ID
If CBSchYear.Text = ("Staff") Then
TxtResults.Text = removeLines("000000", TxtResults)
Else
TxtResults.Text = removeLines("000000000", TxtResults)
End If
TxtResults.Text = removeLines(TxtSchCode.Text & ",,", TxtResults)
TxtResults.Text = TxtResults.Text.Replace(TxtSchCode.Text & ",00", TxtSchCode.Text & ",0")
'strips off blank line
If TxtResults.Text.Length > 0 Then
Dim lines(TxtResults.Lines.Length - 2) As String
Array.Copy(TxtResults.Lines, lines, TxtResults.Lines.Length - 1)
TxtResults.Lines = lines
End If
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub CreateMove()
Dim FirstBox() As String = RTBID.Lines
For i = 0 To UBound(FirstBox)
TxtResults.Text &= TxtSchCode.Text & "," & FirstBox(i).TrimEnd & "," & TxtSchYear.Text & ",moveme,,,," & TxtRefNum.Text & vbCrLf
Next
'Remove Last Line if it contains 000000000 in the Client ID
If CBSchYear.Text = ("Staff") Then
TxtResults.Text = removeLines("000000", TxtResults)
Else
TxtResults.Text = removeLines("000000000", TxtResults)
End If
TxtResults.Text = removeLines(TxtSchCode.Text & ",,", TxtResults)
TxtResults.Text = TxtResults.Text.Replace(TxtSchCode.Text & ",00", TxtSchCode.Text & ",0")
'strips off blank line
If TxtResults.Text.Length > 0 Then
Dim lines(TxtResults.Lines.Length - 2) As String
Array.Copy(TxtResults.Lines, lines, TxtResults.Lines.Length - 1)
TxtResults.Lines = lines
End If
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub CreatePass()
Dim FirstBox() As String = RTBID.Lines
Dim FindID, ReplaceID As String
For i = 0 To UBound(FirstBox)
TxtResults.Text &= FirstBox(i).TrimEnd & ","
Next
FindID = TxtResults.Text
If CBSchYear.Text = ("Staff") Then
FindID = TxtResults.Text
ReplaceID = FindID.Replace(",0000000", "")
Else : ReplaceID = FindID.Replace(",000000000", "")
End If
TxtResults.Text = ReplaceID
TxtResults.Text = TxtResults.Text.Replace(TxtSchCode.Text & "00", TxtSchCode.Text & "0")
'trims the last 2 characters off the line
If TxtResults.Text.Length <> 0 Then
TxtResults.Text = TxtResults.Text.Replace(",,", "")
End If
My.Computer.FileSystem.WriteAllText("C:\Temp\Export_" + Date.Now().ToString("dd-MM-yyyy") + "_" + TxtRefNum.Text + ".txt", TxtResults.Text, True)
End Sub
Private Sub ButCutPaste_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButCutPaste.Click
TxtResults.SelectAll()
If TxtResults.SelectedText <> "" Then
Clipboard.SetText(TxtResults.SelectedText)
TxtResults.SelectedText = ""
MsgBox("Results copied to clipboard", MessageBoxIcon.Information)
Else
MsgBox("No text is selected to cut")
End If
ButCutPaste.Visible = False
End Sub
End Class
