Search between two dates w/ datarows in vb 2010 - vb.net

I am trying to search between two dates in a bound source (SQL table) in VB 2010, using data rows. Since 'between' in unsupported with the data rows function, I used < and >.
So I run this code and the output is 900+ entries when the actual number of entries is 8. After hitting my button a second time without changing anything, the correct number of entries appears.
Private Sub cmdSearch_Click(sender As System.Object, e As System.EventArgs) _
Handles cmdSearch.Click
Dim Expression As String
Dim OrderStr As String = "Area"
Dim DateStr As String
Dim StartDate As String
Dim EndDate As String
Dim Shift As String = ""
Dim Area As String = ""
Dim Product As String
If (DtpStartDate.Value = Nothing Or DtpEndDate.Value = Nothing) Then
MsgBox("Please input a start and end date.")
Exit Sub
End If
If (radShiftAllSearch.Checked <> True _
And radShiftOneSearch.Checked <> True
And radShiftTwoSearch.Checked <> True _
And radShiftThreeSearch.Checked <> True) Then
MsgBox("Please select a shift to search for.")
Exit Sub
End If
Select Case True
Case radShiftOneSearch.Checked
Shift = " AND [Shift] = '1'"
Case radShiftTwoSearch.Checked
Shift = " AND [Shift] = '2'"
Case radShiftThreeSearch.Checked
Shift = " AND [Shift] = '3'"
Case radShiftAllSearch.Checked
Shift = " AND ([Shift] = '1' OR [Shift] = '2' OR [Shift] = '3')"
End Select
**StartDate = DtpStartDate.Value.Subtract(oneday)
EndDate = DtpEndDate.Value.Add(oneday)
'StartDate = Format(DtpStartDate.Value.Subtract(oneday), "M/dd/yyyy")
'EndDate = Format(DtpEndDate.Value.Add(oneday), "M/dd/yyyy")
DateStr = "[Dates] > '" & StartDate & "' AND [Dates] < '" & EndDate & "'"**
If (txtProductSearch.Text = "") Then
Product = ""
Else
Product = "AND [Product] LIKE '" & txtProductSearch.Text & "'"
End If
For h As Integer = 0 To CheckedListBox1.CheckedItems.Count - 1
Dim XDRV As DataRowView = CType(CheckedListBox1.CheckedItems(h), DataRowView)
Dim XDR As DataRow = XDRV.Row
Dim XDisplayMember As String = XDR(CheckedListBox1.DisplayMember).ToString()
If (Area = "") Then
Area = Area & " AND ([Area] LIKE '" & XDisplayMember & "'"
Else
Area = Area & " OR [Area] LIKE '" & XDisplayMember & "'"
End If
Next
If (Area <> "") Then
Area = Area & ")"
End If
Expression = DateStr & Product & Shift & Area
TextBox4.Text = Expression
Dim SearchRows() As DataRow = _
ProductionDataSet.Tables("Production_Daily").Select(Expression, OrderStr)
'foundcount = SearchRows.Count - 1
DataGridView1.DataSource = SearchRows
DataGridView1.Show()
End Sub
Thanks

Related

How to make function work together with Control.CheckForIllegalCrossThreadCalls

When I comment Control.CheckForIllegalCrossThreadCalls = False my function works fine but when uncommented it gives an error
I am using a BackgroundWorker to call a function that inserts values into the database and there is a requirement for me to set Control.CheckForIllegalCrossThreadCalls = False in order for the code to work properly. Now when I set it to false one of the functions does not work as expected. Here is the error
Conversion from string "-0-1-22" to type 'Date' is not valid"
yet when that function works fine
Private Sub btnUpload_Click(sender As Object, e As EventArgs) Handles btnUpload.Click
If Not BackgroundWorker1.IsBusy = True Then
BackgroundWorker1.RunWorkerAsync()
End If
End Sub
I expect the function to come up with "2019-06-11" as date to be inserted to the database of which works fine without Control.CheckForIllegalCrossThreadCalls = False
Here is the code
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
count_rows()
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
MsgBox("Products imported successfully!", MsgBoxStyle.Information, "Import")
Me.Close()
End Sub
Public Sub count_rows()
import_attendance_sheet(1054)
End Sub
Private Sub import_attendance_sheet(ByVal id As Integer)
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = id
ProgressBar1.Value = 0
Dim path As String = txtPath.Text
Dim excel_connection As OleDbConnection
Dim dt As DataTable
Dim cmd As OleDbDataAdapter
'Dim sql As String
'Dim result As Boolean
Dim emp_type_id As String = ""
Dim branch_id As String = ""
Dim bank_id As String = ""
'Dim sheet_dates As New List(Of String)
'excel_connection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" + path + ";Extended Properties=Excel 12.0 Xml; HDR=Yes;")
excel_connection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + path + ";Extended Properties='Excel 12.0 Xml;HDR=No;IMEX=1;';")
cmd = New OleDbDataAdapter("SELECT * FROM [sheet$]", excel_connection)
dt = New DataTable
cmd.Fill(dt)
'initialize symbol row
Dim count As Integer = 6
'Loop through dates(column/header)
For Each column As DataColumn In dt.Columns
Dim colum_name As String = dt.Rows(0)(column.ColumnName).ToString()
'check if column cell is empty
If colum_name = "" Then
'Empty do nothing
Else
'increment symbol row by 1
count = count + 1
'MsgBox(count)
'Loop through rows of a particular date/column/header
For Each r As DataRow In dt.Rows
'check row(empNo) cell is not empty & does not have a string
If r(5).ToString() = "" Or r(5).ToString() = "COY #" Then
'Empty do nothing
Else
'show date | Emp No | Name | symbol index
'MsgBox(colum_name & " " & r(5).ToString() & " " & r(6).ToString() & " " & r(count).ToString())
'do the calculation
Dim employ_id As String = get_employee_id(r(5).ToString)
Dim basic_salary As Decimal = get_employee_basic_salary(r(5).ToString)
Dim staff_type_id As String = get_employee_type_id(r(5).ToString)
Dim days_per_month As Integer = get_employee_days_per_month(staff_type_id)
Dim hours_per_day As Double = get_employee_hours_per_day(staff_type_id)
Dim hourly_rate As Double = basic_salary / days_per_month / hours_per_day
Dim daily_rate As Double = basic_salary / days_per_month
Dim normal_working_hrs As String = get_normal_working_hrs()
Dim shift_duration As String = get_shift_duration()
'get symbol id and its rate
Dim symbol_id As String = get_attendance_symbol_id(r(count).ToString)
Dim symbol_rate As Double = get_attendance_symbol_rate(symbol_id)
Dim symbol_deduction_status As String = get_symbol_deduction_status(symbol_id)
Dim td_amount As Double = 0
If symbol_deduction_status = "DEDUCT" Then
td_amount = hourly_rate
Else
td_amount = 0
End If
Dim overtime As Double = shift_duration - normal_working_hrs
Dim ot_amount As Double = overtime * hourly_rate * symbol_rate
Dim chaka As String = Date.Now.ToString("yyyy")
Dim tsiku As String = Date.Now.ToString("dd")
Dim tsiku_mawu As String = Date.Now.ToString("dddd")
Dim mwezi As String = Date.Now.ToString("MMMM")
' ''insert values into DB
Sql = "INSERT INTO tbl_attendance (employee_id,time_in,time_out,total_hours_worked,overtime,ot_amount,td_amount,attendance_code_id,attendance_code,attendance_date,comment,year,date,day,month,hourly_rate,bsalary,ot_status) VALUES ('" & employ_id & "','" & 0 & "','" & 0 & "','" & shift_duration & "','" & overtime & "','" & ot_amount & "','" & td_amount & "','" & symbol_id & "','" & r(count).ToString & "','" & calc_attendance_date(colum_name) & "','import','" & chaka & "','" & tsiku & "','" & tsiku_mawu & "','" & mwezi & "','" & hourly_rate & "','" & basic_salary & "','" & symbol_rate & "')"
result = save_to_db(Sql)
ProgressBar1.Value = ProgressBar1.Value + 1
'If result Then
' Timer1.Start()
'End If
End If
Next
End If
Next
End Sub
'******* Function which shows the error ****************
Public Function calc_attendance_date(ByVal value As String)
Dim at_date As String = ""
Dim current_month As String = frmMain.cmbMonth.Text
Dim current_year As String = frmMain.cmbYear.Text
Dim mwezi As String
Dim chaka As String
Dim format_day As String = ""
Dim format_month As String = ""
'Date.Now.ToString("yyyy-MM-dd")
'**** find previous month
'when its january
If current_month = "January" And value >= 22 And value <= 31 Then
mwezi = "12"
chaka = Convert.ToInt32(current_year) - 1
at_date = chaka & "-" & mwezi & "-" & value
ElseIf current_month <> "January" And value >= 22 And value <= 31 Then
mwezi = IntMonth() - 1
'day
If value < 10 Then
format_day = "0" & value
ElseIf value >= 10 Then
format_day = value
End If
'format mwezi
If mwezi < 10 Then
format_month = "0" & mwezi
ElseIf mwezi >= 10 Then
format_month = mwezi
End If
chaka = current_year
at_date = chaka & "-" & format_month & "-" & format_day
End If
'**** find current month
If current_month = "January" And value >= 1 And value <= 21 Then
mwezi = IntMonth()
chaka = current_year
'day
If value < 10 Then
format_day = "0" & value
ElseIf value >= 10 Then
format_day = value
End If
'format mwezi
If mwezi < 10 Then
format_month = "0" & mwezi
ElseIf mwezi >= 10 Then
format_month = mwezi
End If
at_date = chaka & "-" & format_month & "-" & format_day
ElseIf current_month <> "January" And value >= 1 And value <= 21 Then
mwezi = IntMonth()
chaka = current_year
'day
If value < 10 Then
format_day = "0" & value
ElseIf value >= 10 Then
format_day = value
End If
'format mwezi
If mwezi < 10 Then
format_month = "0" & mwezi
ElseIf mwezi >= 10 Then
format_month = mwezi
End If
at_date = chaka & "-" & format_month & "-" & format_day
End If
Return at_date
End Function
You shouldn't try to interact with UI controls from a non-UI thread. You can however have code which interacts with those controls on a UI thread by using Control.Invoke. There are a few places where you do it.
Inside import_attendance_sheet
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = id
ProgressBar1.Value = 0
Dim path As String = txtPath.Text
...
ProgressBar1.Value = ProgressBar1.Value + 1
Instead:
Dim path As String
Me.Invoke(
Sub()
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = id
ProgressBar1.Value = 0
path = txtPath.Text
End Sub)
...
Me.Invoke(Sub() ProgressBar1.Value += 1)
All those functions like get_employee_id, get_employee_basic_salary, get_employee_type_id may also interact with the UI, but you don't provide them. If they do (i.e. return a value from a textbox or something) then you need to invoke inside them as well.
Inside calc_attendance_date
Dim current_month As String = frmMain.cmbMonth.Text
Dim current_year As String = frmMain.cmbYear.Text
Instead:
Dim current_month As String
Dim current_year As String
Me.Invoke(
Sub()
current_month = frmMain.cmbMonth.Text
current_year = frmMain.cmbYear.Text
End Sub)
The function IntMonth() is unknown to us too. Again, if it reads from the UI you should invoke the code which does the UI interaction.
The correct way to do this is only invoke when absolutely necessary, i.e. when Control.InvokeRequired. See this example which is very close to yours in that they wanted to use Me.CheckForIllegalCrossThreadCalls = False (BAD!)
Even better, you can write extension methods to automate the Control.InvokeRequired pattern

VBA: Error 3265 - "Item not found in this collection"

In Access 2016 I'm trying to open a recordset and save data from it in other variables, but I keep getting this error.
The program itself has more parts, but I only get error in this one, it just update data on its database.
This is my code:
Option Compare Database
Option Explicit
Private Sub btnValidateTimesheet_Click()
' Update timesheet to "Justificat"
Dim intIdTimesheet As Integer
If IsNull(cmbDraftTimesheets.Value) Then
MsgBox("You have to select a timesheet that is Borrador")
Exit Sub
End If
intIdTimesheet = cmbDraftTimesheets.Column(0)
DoCmd.SetWarnings False
DoCmd.RunSQL "update Timesheets set estat = ""Justificat"" where id=" & intIdTimesheet
DoCmd.SetWarnings True
End Sub
Private Sub btnValidateTimesheetLines_Click()
' We select the timesheet_lines for employee, project, activity and dates selected
' For each justification, a new "Justificat" Timesheet is generated which hang timesheet_lines
' ------------------------------- Variables -------------------------------
Dim dictTsLines As Object
Set dictTsLines = CreateObject("Scripting.Dictionary")
' Form inputs
Dim intCodTreb As Integer
Dim strCodProj As String
Dim dateInici, dateFi As Date
Dim intExercici As Integer
' Query strings
Dim strSQLFrom, strSQLWhere As String
Dim strSQLCount, strSQLJustAct, strSQLTsLines As String
' Recordsets
Dim rsCount, rsJustAct, rsTimesheets, rsTsLines As Recordset
' Aux and others...
Dim continue As Integer
Dim intIdJustificacio, intIdTs As Integer
Dim strActivitat As String
' --------------------------------------- Main ---------------------------------------------
' Taking form data
intCodTreb = cmbTreballador.Column(0)
strCodProj = cmbProjecte.Column(1)
dateInici = txtDataInici.Value
dateFi = txtDataFi.Value
' We check the dates are correct
If IsNull(dateInici) Or IsNull(dateFi) Then
MsgBox("Dates can't be null")
Exit Sub
End If
If dateFi < dateInici Then
MsgBox("Start date must be earlier or the same as final date")
Exit Sub
End If
If year(dateInici) <> year(dateFi) Then
MsgBox("Dates must be in the same year")
Exit Sub
End If
intExercici = year(dateInici)
' Make of the clause FROM and WHERE of the select query of timesheet_lines
strSQLFrom = " from (timesheet_lines tsl " & _
" left join timesheets ts on tsl.timesheet_id = ts.id) " & _
" left join justificacions j on j.id = ts.id_justificacio "
strSQLWhere = " where ts.estat = ""Borrador"" " & _
" and tsl.data >= #" & Format(dateInici, "yyyy/mm/dd") & "# " & _
" and tsl.data <= #" & Format(dateFi, "yyyy/mm/dd") & "# "
If Not IsNull(intCodTreb) Then
strSQLWhere = strSQLWhere & " and tsl.cod_treb = " & intCodTreb
End If
If Not IsNull(strCodProj) Then
strSQLWhere = strSQLWhere & " and j.cod_proj=""" & strCodProj & """ "
End If
' Alert how much timesheet_lines are going to be validated
strSQLCount = "select count(*) " & strSQLFrom & strSQLWhere
Set rsCount = CurrentDb.OpenRecordset(strSQLCount)
Continue Do = MsgBox( rsCount(0) & " registries are going to be validated" & vbNewLine & _
"Do you want to continue?", vbOKCancel)
If continue <> 1 Then
Exit Sub
End If
' We select the tuples Justificacio, Activitat of timesheet_lines selected
strSQLJustAct = "select distinct ts.id_justificacio " & strSQLFrom & strSQLWhere
Set rsJustAct = CurrentDb.OpenRecordset(strSQLJustAct)
Set rsTimesheets = CurrentDb.OpenRecordset("Timesheets")
' A new timesheet is generated for each tupla
Do While Not rsJustAct.EOF
intIdJustificacio = rsJustAct(0)
strActivitat = rsJustAct(1)
rsTimesheets.AddNew
rsTimesheets!data_generacio = Now()
rsTimesheets!estat = "Justificat"
rsTimesheets!Id_justificacio = intIdJustificacio
rsTimesheets!activitat = strActivitat
rsTimesheets!data_inici = dateInici
rsTimesheets!data_fi = dateFi
rsTimesheets!exercici = intExercici
intIdTs = rsTimesheets!Id
rsTimesheets.Update
' We save the related id of the selected timesheet in a dictionary
dictTsLines.Add intIdJustificacio & "_" & strActivitat, intIdTs
rsJustAct.MoveNext
Loop
' We select all the affected timesheet_lines and we update the related timesheet using the dictionary
strSQLTsLines = "select tsl.id, tsl.timesheet_id, ts.id_justificacio, ts.activitat " & strSQLFrom & strSQLWhere
Set rsTsLines = CurrentDb.OpenRecordset(strSQLTsLines)
With rsTsLines
Do While Not .EOF
.EDIT
intIdJustificacio = !Id_justificacio
strActivitat = !activitat
!timesheet_id = dictTsLines.Item(intIdJustificacio & "_" & strActivitat)
.Update
.MoveNext
Loop
End With
rsTimesheets.Close
Set rsCount = Nothing
Set rsJustAct = Nothing
Set rsTimesheets = Nothing
Set rsTsLines = Nothing
End Sub
Debugger: The error is coming up at the line:
strActivitat = rsJustAct(1)
I checked that the data the recordset is saving exists and it does.
Your recordset contains just one column ("select distinct ts.id_justificacio"), but you are trying to read second column strActivitat = rsJustAct(1)
Add requred column to recordset.

Extract employees between 2 Hire Dates VBA and SQL

I have designed a macro which should extract from a workbook database all employees who were hired between 2 Dates.
Unfortunatley I'm getting a error mesage when I run the query.
Error:
Data Type mismatch in criteria expression.
I don't know how to fix the issue.
My regional settings:
Short date: dd.MM.yyyy
Long date: dddd, d.MMMM.yyyy
First day of week: Monday
Here the code:
Public Sub HIREDATE()
Application.ScreenUpdating = False
Dim cnStr As String
Dim rs As ADODB.Recordset
Dim query As String
Dim fileName As String
Dim pom1 As String
Dim x As String, w, e, blad As String, opis As String
Set w = Application.FileDialog(msoFileDialogFilePicker)
With w
.AllowMultiSelect = False
If .Show = -1 Then
fileName = w.SelectedItems(1)
Else
Exit Sub
End If
End With
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & fileName & ";" & _
"Extended Properties=Excel 12.0"
On Error GoTo Anuluj
x = InputBox("Wprowadz dwie daty od do oddzielając je przecinkiem -- Przykład 01.01.2015,01.05.2015")
strg = ""
k = Split(x, ",")
e = Application.CountA(k)
For m = LBound(k) To UBound(k)
If e = 1 Then
strg = strg & " [DEU1$].[Last Start Date] = '" & k(m) & "';"
Exit For
ElseIf e = 2 And e Mod 2 = 0 Then
strg = " [DEU1$].[Last Start Date] BETWEEN '" & CDate(k(m)) & "' AND '" & CDate(k(m + 1)) & "';"
Exit For
End If
Next m
On Error GoTo opiszblad
Set rs = New ADODB.Recordset
query = "SELECT [Emplid], [First Name]+ ' ' +[Last Name] From [DEU1$] WHERE" & strg
rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
Cells.Clear
Dim cell As Range, i As Long
With Range("A3").CurrentRegion
.Select
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
Range("A4").CopyFromRecordset rs
.Cells.Select
.EntireColumn.AutoFit
End With
rs.Close
Application.ScreenUpdating = True
Exit Sub
Anuluj:
Exit Sub
opiszblad:
e = Err.Number
blad = Err.Source
opis = Err.Description
opisbledu = MsgBox(e & " " & blad & " " & opis, vbInformation, "Błąd")
Exit Sub
End Sub
You need properly formatted string expressions for your dates and to validate the user input:
If e = 1 And IsDate(k(m)) Then
strg = strg & " [DEU1$].[Last Start Date] = #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "#;"
Exit For
ElseIf e = 2 And e Mod 2 = 0 And IsDate(k(m + 1)) Then
strg = " [DEU1$].[Last Start Date] BETWEEN #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "# AND #" & Format(DateValue(k(m + 1)), "yyyy\/mm\/dd") & "#;"
Exit For
End If

Batching results SQL Server 2008 R2

How would I go about batching records in a select statement I Have to conserve bandwidth as delaying with shop tills so bandwidth is at a premium. I will be reading the batch size from configuration file and passing to this select statement:
Friend Function SelectAllPendingDeliveries() As String Implements iScriptBuilder.SelectAllPendingDeliveries
Dim retVal As String = ""
retVal = "Select * from batchtable where [location] is not null and isprocessed = 0"
Return retVal
End Function
How would I go about doing this is the table structure
#Anthoy I think this is where I am getting tripped up how Would i control it here to for it to loop until the end of the recordset so it executes in batches this is the function that calls the select statement
#Anthory I meen this code i pasted the wrong proc in
Friend Function CreateLiveSale(ByVal wrpPush As LiveSales.wrpPush, ByVal rCount As Int32, ByVal request As LiveSales.requestPush, ByVal orderLineData As DataTable, ByVal packetBatchSize As String) ', ByVal orderNumber As String, ByVal orderLineReference As String, ByVal uniqueFilename As String, ByVal tagBarCode As String, ByVal costPrice As String, ByVal deliveryQty As Int32, ByVal orderLineData As DataTable) As Boolean
Dim retVal As Boolean
Dim settings As LiveSalesBackOfficeClient.infoLiveSalesBackOfficeClient = _
(New LiveSalesBackOfficeClient.configurationLoader).LoadConfiguration
Dim cfb As New cfbConfiguration
Dim pushOrderIncQTY As New infoPushOrderIncQTY()
Dim totalRecords As Integer = orderLineData.Rows.Count
Dim pushOrderInc As List(Of infoPushOrderIncQTY) = New List(Of infoPushOrderIncQTY)() ' create a generic list
Dim recordCount As Integer = 0
Dim batchNumber As Integer
Dim batchNumberpad As String
Dim filenameSplit As String()
For Each thisentry In orderLineData.Rows
If recordCount = 0 Then
filenameSplit = thisentry.Item("unqiueFilename").ToString().Split("_")
batchNumber = recordCount + 1
batchNumberpad = Path.GetFileNameWithoutExtension(filenameSplit(2)) & "_" & batchNumber.ToString("D3") & ".csv"
With request
.companyID = settings.companyID
.machineID = settings.machineID
.uniqueBatchIdentifier = batchNumberpad
End With
End If
With pushOrderIncQTY
.costPrice = thisentry.Item("costPrice")
.externalTimeStamp = DateTime.Now()
.RootPLU = thisentry.Item("tagbarcode") 'set this to the barcode from the file
.sizeBit = -666
.supplierID = cfb.SupplierID
.orderReference = thisentry.Item("OrderNumber")
.orderLineReference = ""
.externalTransaction = ""
.sourceShop = cfb.SiteId 'set to the GEMINI location ID for this store (you will have to get this from your configuration file
.destinationShop = cfb.SiteId 'set this to the same as the sourceshop
.QTY = thisentry.Item("ActQty")
.whichQty = LiveSales.infoPushOrderIncQTY.Which_OrderQty.delivered 'only available option at present
End With
recordCount = recordCount + 1
pushOrderInc.Add(pushOrderIncQTY) ' add it to the list for batching
If recordCount = cfb.PacketBatchSize Then ' only when the record count = the packetsize fire off
pushOrderInc.Clear()
recordCount = 0
End If
If cfb.PacketBatchSize > 0 Then
CallWebSerivce(wrpPush, request, pushOrderInc.ToArray())
End If
Next
If cfb.PacketBatchSize = 0 Then ' if their is a batch size then lets just processe
'call the webservice
CallWebSerivce(wrpPush, request, pushOrderInc.ToArray())
End If
Return retVal
End Function
#anthoy the above gets called by this procedure so it does its hear the looping needs to happen
OpenConnection()
Dim results As DataTable = connection.SqlSelectToDataTable(scriptBuilder.SelectAllPendingDeliveries)
Dim dataForEmail As String = ""
Dim msg As String = ""
msg = "The Following Deliverys where processed for the Following Ordernumbers at " & DateTime.Now.ToString() & Chr(13)
dataForEmail = "Order Number" & vbTab & "BarCode" & vbTab & vbTab & vbTab & "Product Name" & vbTab & vbTab & vbTab & vbTab & vbTab & "Brand" & vbTab & vbTab & vbTab & "Size" & vbTab & vbTab & "Colour" & vbTab & "Qty" & vbTab & vbTab & "RRP" & vbTab & Chr(13)
Dim totalcost As Decimal
Dim cnt As Int16 = 0
Dim fileName As String = ""
If Not IsNothing(results) AndAlso Not IsNothing(results.Rows) _
AndAlso results.Rows.Count > 0 Then
Dim rrpprice As Double = 0.0
For Each thisRow As DataRow In results.Rows
If IsDBNull(thisRow.Item("RRPPrice")) Then
rrpprice = 0.0
Else
rrpprice = thisRow.Item("RRPPrice")
End If
fileName = thisRow.Item("unqiueFilename")
totalcost = totalcost + rrpprice * thisRow.Item("QTY")
dataForEmail = dataForEmail & BuildReportFoEmail(thisRow)
connection.ExecuteNonQuerySql(scriptBuilder.SetDeliveryStatus(2, 1, thisRow.Item("r3DeliveryId")))
cnt = cnt + 1
Next
connection.ExecuteNonQuerySql(scriptBuilder.SetDeliveryStatus(1, 0))
CreateLiveSalesDeliveryForR3(cnt, fileName, results, cfb.PacketBatchSize)
dataForEmail = dataForEmail & vbCrLf & "Total Price " & totalcost.ToString() & vbCrLf & BuildExceptionsForEmail(results) & vbCrLf
End If
SendEmailViaWebService(dataForEmail, cfb.EmailForDeliverys, cfb.FullNameForEmailSubject, msg)
MsgBox("Delvery Complete", vbInformation, "Delivery Import")
CloseConnection()

vbnet multiple combobox fill with one dataset

i have the following code to fill two comboboxes using one dataset:
Private Sub sub_cbo_type_load()
Dim ds As New DataSet
ds = cls.cbo_type()
If ds IsNot Nothing _
AndAlso ds.Tables.Count > 0 _
AndAlso ds.Tables(0).Rows.Count > 0 Then
Me.r_cbo_type.DataSource = ds.Tables(0)
Me.r_cbo_type.DisplayMember = "desc"
Me.r_cbo_type.ValueMember = "code"
Me.r_cbo_type.SelectedIndex = -1
Me.m_cbo_type.DataSource = ds.Tables(0)
Me.m_cbo_type.DisplayMember = "desc"
Me.m_cbo_type.ValueMember = "code"
Me.m_cbo_type.SelectedIndex = -1
End If
End Sub
the problems is: whenever the index is changed in one combobox, it's automatically changed in the other one too.
does anyone know how can i solve this?
thanks for your time.
Try cloning the tables:
Private Function CopyTable(ByVal sourceTable As DataTable) As DataTable
Dim newTable As DataTable = sourceTable.Clone
For Each row As DataRow In sourceTable.Rows
newTable.ImportRow(row)
Next
Return newTable
End Function
Then your data sources would be referencing different sources:
Me.r_cbo_type.DataSource = CopyTable(ds.Tables(0))
Me.m_cbo_type.DataSource = CopyTable(ds.Tables(0))
do like this
Private Sub btn_update1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn_update1.Click
If MsgBox("Are you sure to update?" & "", MsgBoxStyle.YesNo, "Confirmation") = MsgBoxResult.Yes = True Then
Dim transmode As String = vbNullString
Dim byair As String = vbNullString
Dim bysea As String = vbNullString
If rb_air.Checked = True Then
transmode = "A"
byair = txt_mserial.Text '.Substring(txt_mserial.TextLength - 4, 4)
bysea = vbNullString
ElseIf rb_sea.Checked = True Then
transmode = "B"
byair = vbNullString
bysea = txt_mserial.Text '.Substring(txt_mserial.TextLength - 4, 4)
End If
Try
If con.State = ConnectionState.Closed Then con.Open()
global_command = New SqlCommand("update ytmi_finished_products set rev_ctrl_no = '" & txt_mrev.Text & "', by_air = '" & byair & "', by_sea = '" & bysea & "', transport_mode = '" & transmode & "' where REPLACE(prod_no, '-', '') +'-'+ ISNULL(CONVERT(varchar(50), prod_sx), '') + prod_lvl = '" & txt_mpart.Text & "' and cast(serial_no as numeric) = '" & txt_mserial.Text & "' and req_box_qty = '" & txt_mqty.Text & "' and remarks is null", con)
global_command.ExecuteNonQuery()
global_command.Dispose()
MsgBox("Successfully Updated!", MsgBoxStyle.Information, "Message")
mclear()
Catch ex As Exception
MsgBox("Trace No 20: System Error or Data Error!" + Chr(13) + ex.Message + Chr(13) + "Please Contact Your System Administrator!", vbInformation, "Message")
End Try
End If
End Sub