Loop same case in select case in vb.net - vb.net

I want to come up with this problem.... if there's only 1 false in loop then it will not insert into database and vise versa if all true then it will insert to database.
Here's is my code
Public Function Check_Foreign_Key(ByVal select_column_name As String, ByVal table_name As String, ByVal where_column_name As String, ByVal where_value As String, ByRef Foreign_Key As String) As Boolean
Dim dt_service_provider_id As DataTable = ExecuteSQLQuery("select " & select_column_name & " from " & table_name & " where " & where_column_name & " = '" & where_value & "'")
If dt_service_provider_id.Rows.Count = 0 Then
Return False
Else
Foreign_Key = dt_service_provider_id.Rows(0).Item(0).ToString()
Return True
End If
End Function
For Each dr As DataRow In dt.Rows
Dim dt_rows as Integer = 0
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
If dr(0).ToString.Length > 50 And dr(0).ToString = "" And dr(0).ToString Is Nothing Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, "Character is greater than 50")
'in here i want to continue checking go to next, i think i got error in cheking if dr(0) is empty
Else
If dr(1).ToString.Length > 50 And dr(1).ToString = "" And dr(1).ToString Is Nothing Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, "Character is greater than 50")
'in here i want to continue again to next
Else
Select Case site_id
Case False
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
Return
End Select
End If
End If
dt_row += 1
Next
THis is the code i only i know but unfortunately i cannot get my logic it always inserting rather it have 1 false

Hope this solve the problem
Dim blnAllTrue As Boolean = True
For Each dr As DataRow In dt.Rows
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
blnAllTrue = blnAllTrue And site_id
If site_id = False Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
End If
Next
If blnAllTrue = True Then
'insert into your database
End If

Try this
Private SaveToDB()
For Each dr As DataRow In dt.Rows
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
Select Case site_id
Case False
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
Return
End Select
Next
'if you got here means no error
'NOTE: You should loop again and save the rows
For Each dr As DataRow In dt.Rows
'Your code to save into the database here
Next
End Sub

Related

DataTable.Delete() Removing rows before Accept Changes

I'm having an issue where I mark several rows for deletion within a loop, but when it gets to a certain point in the loop, the rows actually start to be removed.
As you can see what I'm basically doing is checking if the row needs to be deleted and if so, add it to a new table and delete it.
The problem is this works for the first 60 ish rows, then all of a sudden the rows appear to actually be removed and it eventually throws a row with that index doesn't exist error (at 65).
The original table is a list of contacts with firstname, lastname, email and company, with 70 records.
I tried to cut the list in half, but then the issue started happening at around row 23.
dtSelectCompany = dt_data.Clone
Dim s_company As String
Dim b_add As Boolean
Dim dtCompanies As Data.DataTable
For i = 0 To dt_data.Rows.Count - 1
b_add = False
s_company = dt_data.Rows(i).Item(columnsDictionary("company")).ToString
If s_company = "" Then : b_add = True
Else
dtCompanies = crm_functions.getCompaniesByName(s_company.Replace(" ", "%"))
If dtCompanies.Rows.Count > 1 Then : b_add = True
ElseIf dtCompanies.Rows.Count = 1 Then
dt_data.Rows(i).Item(columnsDictionary("company")) = dtCompanies.Rows(0).Item("id")
Else : b_add = True
End If
End If
If b_add Then
Dim temp_row As Data.DataRow = dtSelectCompany.NewRow
temp_row.ItemArray = dt_data.Rows(i).ItemArray.Clone()
temp_row.Item("fullName") = temp_row.Item(columnsDictionary("firstname")) & " " & temp_row.Item(columnsDictionary("lastname"))
dtSelectCompany.Rows.Add(temp_row)
dt_data.Rows(i).Delete()
End If
Next
Instead of a counter, use a datarow, for example:
dtSelectCompany = dt_data.Clone
Dim s_company As String
Dim b_add As Boolean
Dim dtCompanies As Data.DataTable
Dim MyDataRow as DataRow
For Each MyDataRow IN dt_data.Rows
b_add = False
s_company = MyDataRow("company").ToString
If s_company = "" Then : b_add = True
Else
' not sure what crm_functions is, so left this alone
dtCompanies = crm_functions.getCompaniesByName(s_company.Replace(" ", "%"))
If dtCompanies.Rows.Count > 1 Then : b_add = True
ElseIf dtCompanies.Rows.Count = 1 Then
MyDataRow("company")) = dtCompanies.Rows(0).Item("id")
Else : b_add = True
End If
End If
If b_add Then
Dim temp_row As Data.DataRow = dtSelectCompany.NewRow
temp_row = MyDataRow
temp_row.Item("fullName") = temp_row.Item(columnsDictionary("firstname")) & " " & temp_row.Item(columnsDictionary("lastname"))
dtSelectCompany.Rows.Add(temp_row)
MyDataRow.Delete()
End If
Next
Wrote this off the top of my head, so .....

Search in datagrid using value in textbox

How can I display value in msgbox. In the first column in datagrid is looking value based on textbox and I want display value from second column and the same row in msgbox. Now I have only "Item found"
Here are columns
Private Sub PictureBox12_Click(sender As Object, e As EventArgs) Handles PictureBox12.Click
Dim temp As Integer = 0
For i As Integer = 0 To List2DataGridView.RowCount - 1
For j As Integer = 0 To List2DataGridView.ColumnCount - 1
If List2DataGridView.Rows(i).Cells(j).Value.ToString = TextBox2.Text Then
MsgBox("Intem found")
temp = 1
End If
Next
Next
If temp = 0 Then
MsgBox("Item not found")
End If
End Sub
You can enumerate List2DataGridView.Rows directly via For Each, there is no need to use indexing to visit them.
For Each row As DataGridViewRow In List2DataGridView.Rows
Then, for each row we test its value and when we find the matching row, we display a message incorporating its value. We have access to the value because it is in scope. When we find the matching element we exit the For Each
For Each row As DataGridViewRow In List2DataGridView.Rows
If row.Cells.Item(1).Value = TextBox2.Text Then
MsgBox("Item is found in row: " & row.Index)
MsgBox("Value of second column in this row: " & row.Cells.Item(1).Value)
Exit For
End If
Next
MsgBox("Item not found")
However this is not the most elegant solution and suffers from poor readability. Specifically, use of Exit For is somewhat ugly and makes the code harder to grok at a clance.
We can do better by using LINQ.
Dim Matches = From row As DataGridViewRow In List2DataGridView.rows
Let CellValue = row.Cells.Item(1).Value
Where CellValue = TextBox2.Text
Select New With {CellValue, row.Index}
Dim Match = Matches.FirstOrDefault()
If Match IsNot Nothing Then
MsgBox("Item is found in row: " & Match.Index)
MsgBox("Value of second column in this row: " & Match.CellValue)
End If
Private Sub PictureBox12_Click(sender As Object, e As EventArgs) Handles PictureBox12.Click
Dim barcode As String
Dim rowindex As String
Dim found As Boolean = False
barcode = InputBox("Naskenujte čárový kód ||||||||||||||||||||||||||||||||||||")
If Len(Trim(barcode)) = 0 Then Exit Sub 'Pressed cancel
For Each row As DataGridViewRow In List2DataGridView.Rows
If row.Cells.Item("DataGridViewTextBoxColumn1").Value = barcode Then
rowindex = row.Index.ToString()
found = True
Dim actie As String = row.Cells("DataGridViewTextBoxColumn2").Value.ToString()
MsgBox("Čárový kód: " & barcode & vbNewLine & "Číslo dílu je: " & actie, , "Vyhledání dílu")
Exit For
End If
Next
If Not found Then
MsgBox("Item not found")
End If
End Sub

treeview disappeared when i reopen the form

I would like to ask for your help. I am stuck to this for more than two days, I've searched the net but unfortunately got no answer.
I have a program in vb 2008 and a database (SQL Server 2008). I have this form which contains treeview. The items display is selected from the database. When i run the program and open the form the treeview items displayed (at first), but when i closed the form and try to open it again the treeview disappear. I dont know why :( . Why is it disappearing? Can somebody help me please. Thank you.
Below is my code....
#form_load
Private Sub frmProfile_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Call conecDB()
Call initCMD()
FillTable()
CreateTree() 'create the treeview node
findNode() 'find and checked the selected nodes that was given to the profile
End Sub
'the functions
Private Sub FillTable()
'tv1.Nodes.Clear()
dtable.Columns.Add("ID", GetType(Integer))
dtable.Columns.Add("NAME", GetType(String))
dtable.Columns.Add("PARENT", GetType(Integer))
dtable.Columns.Add("LEVEL", GetType(Integer))
qSQL = "select mod_id,name,parent,level,sort,mnu_name from module where status='A' and parent!=-1"
With comDB
.CommandText = qSQL
rdDB = .ExecuteReader
End With
Do While rdDB.Read
dtable.Rows.Add(rdDB!mod_id, rdDB!name.ToString(), rdDB!parent)
My.Application.DoEvents()
Loop
For i = 0 To dtable.Rows.Count - 1
Dim ID1 As String = dtable.Rows(i).Item("ID").ToString
dtable.Rows(i).Item("LEVEL") = FindLevel(ID1, 0)
Next
rdDB.Close()
End Sub
Private Function FindLevel(ByVal ID As String, ByRef Level As Integer) As Integer
For i = 0 To dtable.Rows.Count - 1
Dim ID1 As String = dtable.Rows(i).Item("ID").ToString
Dim Parent1 As String = dtable.Rows(i).Item("PARENT").ToString
If ID = ID1 Then
If Parent1 = 0 Then
Return Level
Else
Level += 1
FindLevel(Parent1, Level)
End If
End If
Next
Return Level
End Function
Private Sub CreateTree()
tv1.Nodes.Clear()
Dim MaxLevel1 As Integer = CInt(dtable.Compute("MAX(LEVEL)", ""))
Dim i, j As Integer
For i = 0 To MaxLevel1
Dim Rows1() As DataRow = dtable.Select("LEVEL = " & i)
For j = 0 To Rows1.Count - 1
Dim ID1 As String = Rows1(j).Item("ID").ToString
Dim Name1 As String = Rows1(j).Item("NAME").ToString
'Dim mName As String = Rows1(j).Item("mNAME").ToString
Dim Parent1 As String = Rows1(j).Item("PARENT").ToString
If Parent1 = 0 Then
tv1.Nodes.Add(ID1, Name1)
Else
Dim TreeNodes1() As TreeNode = tv1.Nodes.Find(Parent1, True)
If TreeNodes1.Length > 0 Then
TreeNodes1(0).Nodes.Add(ID1, Name1)
End If
End If
Next
Next
End Sub
Private Sub findNode()
Dim rName As String = String.Empty
Dim b As Boolean = True
qSQL = "select access_id,mnu_name from profile_details where prof_id=" & lblPID.Text & ""
With comDB
.CommandText = qSQL
rdDB = .ExecuteReader
End With
Do While rdDB.Read
rName = rdDB!access_id.ToString()
Try
Dim arr As TreeNode() = tv1.Nodes.Find(rName, b)
For i = 0 To arr.Length - 1
tv1.SelectedNode = arr(i)
tv1.SelectedNode.Checked = True
Next
Catch
MsgBox(Err)
End Try
Loop
rdDB.Close()
End Sub

Recursive Function Not Returning

I am hopeing someone can help me here with a recursive function I have that is not returning either true or false as I would have espected it to. The function loops through a Active Directory group for its members and then calls itself if it encounters any groups within the membership in order to gets its members as well. I am trying to return either true or false based on if any errors were encountered but not haveing any luck at all. It appears to just hang and never return back to the primary calling sub that starts the recursive function. Below is my code I am using:
Private Sub StartAnalysis(ByVal grp As String, ByVal grpdn As String, ByVal reqid As String)
Dim searchedGroups As New Hashtable
'prior work before calling sub
searchedGroups.Add(grp, 1)
Dim iserror As Boolean = GetGroupMembers(grpdn, searchedGroups, reqid)
If iserror = False Then
'do stuff
Else
'do stuff
End If
'cleanup
End Sub
Public Function GetGroupMembers(ByVal groupSearch As String, ByVal searchedGroups As Hashtable, ByVal requestID As String) As Boolean
Dim iserror As Boolean = False
Try
Dim lastQuery As Boolean = False
Dim endLoop As Boolean = False
Dim rangeStep As Integer = 999
Dim rangeLow As Integer = 0
Dim rangeHigh As Integer = rangeLow + rangeStep
Do
Dim range As String = "member"
If lastQuery = False Then
range = String.Format("member;range={0}-{1}", rangeLow, rangeHigh)
Else
range = String.Format("member;range={0}-*", rangeLow)
endLoop = True
End If
Dim group As SearchResult = QueryObject(groupSearch, range)
Dim groupCN As String = group.Properties("cn")(0).ToString
If group.Properties.Contains(range) Then
For Each member As Object In group.Properties(range)
Dim user As SearchResult = QueryObject(member.ToString, "member")
Dim userCN = user.Properties("cn")(0).ToString
If Not user.Properties.Contains("member") Then
Dim userMail = String.Empty
If user.Properties.Contains("mail") Then
userMail = user.Properties("mail")(0).ToString
End If
userCN = userCN.Replace("'", "''")
Dim qry As String = _
"INSERT INTO group_analysis_details (request_id, member_name, member_email, member_group) " & _
"values ('" & requestID & "', '" & userCN & "', '" & userMail & "', '" & groupCN & "')"
Dim sqlConn As SqlConnection = New SqlConnection(cs)
Dim sqlCmd As SqlCommand = New SqlCommand(qry, sqlConn)
sqlConn.Open()
sqlCmd.ExecuteNonQuery()
sqlConn.Close()
sqlCmd.Dispose()
sqlConn.Dispose()
Else
If Not searchedGroups.ContainsKey(userCN) Then
searchedGroups.Add(userCN, 1)
iserror = GetGroupMembers(user.Properties("distinguishedname")(0).ToString, searchedGroups, requestID)
If iserror = True Then Return iserror
Else
searchedGroups(userCN) += 1
End If
End If
Next
Else
lastQuery = True
End If
If lastQuery = False Then
rangeLow = rangeHigh + 1
rangeHigh = rangeLow + rangeStep
End If
Loop While endLoop = False
Return iserror
Catch ex As Exception
myEvents.WriteEntry("Error while analyzing the following group: " & groupSearch & vbCrLf & vbCrLf & _
"Details of the error are as follows: " & ex.Message, EventLogEntryType.Error)
Return True
End Try
End Function
Hopefully someone can point out where I might be making my error is this.
Thanks,
Ron
Generally if you're using a 'Do...Loop While' and manually setting the exit condition inside the loop it's very easy to get stuck in an infinite loop which is what causes the program to hang.
It looks like you're not setting endloop = True in all circumstances. Try changing it to an Exit Do and adding one to each of the various conditions you have. A bit of trial and error will be required to get it just right.
Also to make your life easier extract the database insert code into a seperate function and call it when needed.

DataTable.Select with AND conditions doesn't give expected results

I'm trying to compare two datatables and I'm doing some tests using DataTable.Select on two identical datatables:
Using DT_NewData As DataTable = DT_DBData.Copy
For x As Short = 0 To DT_NewData.Rows.Count - 1
Dim SelRows As DataRow() = DT_DBData.Select( _
"Type='" & DT_NewData.Rows(x)("Type") & "'" & _
" AND In_Date='" & DT_NewData.Rows(x)("In_Date") & "'" & _
" AND Out_Date='" & DT_NewData.Rows(x)("Out_Date") & "'")
Next
But SelRows.Length is always 0. What's wrong in my code?
Although is a little strange the copy of the table, try this:
Suppose that Type is String
Imports Microsoft.VisualBasic
Imports System.Linq
Module StartupModule
Sub Main()
' Declare the table.
Dim originalDataTable As New DataTable
' Declare the table columns.
With originalDataTable.Columns
.Add("Type", GetType(String))
.Add("InDate", GetType(DateTime))
.Add("OutDate", GetType(DateTime))
End With
' Delegate to add rows.
Dim addRow As Action(Of String, DateTime?, DateTime?) = Sub(text, inDate, outDate)
Dim newRow As DataRow = originalDataTable.NewRow()
With newRow
If (Not String.IsNullOrEmpty(text)) Then
.SetField(Of String)("Type", text)
End If
If (inDate.HasValue) Then
.SetField(Of DateTime?)("InDate", inDate.Value)
End If
If (outDate.HasValue) Then
.SetField(Of DateTime?)("OutDate", outDate.Value)
End If
End With
originalDataTable.Rows.Add (newRow)
End Sub
' Adding rows to the table.
addRow("type1", #2/2/2017#, Nothing)
addRow(Nothing, #1/25/2016#, Nothing)
addRow(Nothing, Nothing, #1/30/2016#)
' Copy the table
Dim copiedDataTable As DataTable = originalDataTable.Copy
' Loop through copied table rows.
For i As Integer = 0 To copiedDataTable.Rows.Count - 1
Dim type As String = copiedDataTable.Rows(i).Field(Of String)("Type")
Dim inDate As DateTime? = copiedDataTable.Rows(i).Field(Of DateTime?)("InDate")
Dim outDate As DateTime? = copiedDataTable.Rows(i).Field(Of DateTime?)("OutDate")
' Using DataTable Select.
Dim filter As String = String.Format("{0} {1} {2}",
If(type Is Nothing, "( Type Is Null )", String.Format("( Type = '{0}' )", type)),
If(Not inDate.HasValue, "And ( InDate Is Null )", String.Format("And ( InDate = '{0}' )", inDate.Value.ToString())),
If(Not outDate.HasValue, "And ( OutDate Is Null )", String.Format("And ( OutDate = '{0}' )", outDate.Value.ToString())))
Dim usingSelectRows As DataRow() = originalDataTable.Select(filter)
Console.WriteLine("usingSelectRows.Count = {0}", usingSelectRows.Count)
' Using Linq.
Dim typeSelector As Func(Of DataRow, Boolean) = Function(r)
If (IsNothing(type)) Then
Return IsNothing(r.Field(Of String)("Type"))
Else
Return r.Field(Of String)("Type") = type
End If
End Function
Dim inDateSelector As Func(Of DataRow, Boolean) = Function(r)
If (Not inDate.HasValue) Then
Return Not r.Field(Of DateTime?)("InDate").HasValue
Else
Return r.Field(Of DateTime?)("InDate").GetValueOrDefault.CompareTo(inDate.GetValueOrDefault) = 0
End If
End Function
Dim outDateSelector As Func(Of DataRow, Boolean) = Function(r)
If (Not outDate.HasValue) Then
Return Not r.Field(Of DateTime?)("OutDate").HasValue
Else
Return r.Field(Of DateTime?)("OutDate").GetValueOrDefault.CompareTo(outDate.GetValueOrDefault) = 0
End If
End Function
Dim usingLinqRows = From r In originalDataTable.AsEnumerable
Where
(typeSelector(r)) AndAlso
(inDateSelector(r)) AndAlso
(outDateSelector(r))
Select r
Console.WriteLine("usingLinqRows.Count = {0}", usingLinqRows.Count)
Console.WriteLine()
Next
Console.ReadLine()
End Sub
End Module
Always use the Field extension of DataRow to retrieve data.