I'm not a VB 6 programmer and I'm struggling to pull the SQL out of this VB 6 form. Any tips would be greatly appreciated. I removed some DIM statements. Basically this was a form with 4 different reports that formatted the data. Of course this is a legacy app and I'm trying to extract the report logic here.
**** Removed some form code to comply with character limit ****
#End Region
Private Sub frmrptProductionControl_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
mkdtPC()
mkdtReport()
mkdtPCSorted()
End Sub
Function getMinEOQ(ByVal Material As String, ByVal DBConnection As SqlConnection) As Double
Dim UserValues As Int64
popdtParam(Material, "STRING", "MATERIAL")
Dim strSQL As String = "SELECT USER_VALUES FROM MATERIAL WHERE MATERIAL = #MATERIAL"
Dim getValue As New getSingleValuePQ(strSQL, "USER_VALUES", "NUMERIC", dtParam, DBConnection)
UserValues = getValue.Value
dtParam.Clear()
popdtParam(UserValues, "NUMERIC", "USERVALUES")
strSQL = "SELECT NUMERIC2 FROM USER_VALUES WHERE USER_VALUES = #USERVALUES"
getValue = New getSingleValuePQ(strSQL, "NUMERIC2", "NUMERIC", dtParam, DBConnection)
Return getValue.Value
End Function
Private Sub popdtPC(ByVal StartDate As Date, ByVal EndDate As Date, ByVal ReportType As String, Optional ByVal SortByPart As Boolean = 0)
dsPC.Clear()
Dim strsql As String
strsql = "SELECT MATERIAL, JOB, STOCK, INPROCESS, LTAQTY, SALESPRICE, "
strsql &= "LT, LTDEMANDDATE, DEPLETIONDATE, DEMAND6MONTHS, "
strsql &= "DEMAND12MONTHS, PROFIT, UNITCOST, LTDEMAND FROM tblPartData "
If ReportType = "PRODUCTIONCONTROL" Then
strsql &= "WHERE MATERIAL NOT IN (SELECT MATERIAL FROM TBLCRITICALPARTS) "
End If
Dim drdGetData As SqlDataReader = Nothing
Dim cmmGetData As New SqlCommand(strsql, cnSQL)
Try
drdGetData = cmmGetData.ExecuteReader()
Catch objException As SqlException
Dim objerror As SqlError
For Each objerror In objException.Errors
MsgBox(objException.Message)
Next
End Try
Dim Material, NewestJob, Deliveries, Comments, PersonResp, ExpireDate, CriticalColor, Program As String
Dim Stock, InProcess, LTAQty, LT, Demand, Demand6Months, _
Demand12Months, PromisedQty, PartCount, DelinquentCount, LTDemand, _
NewestJobQty As Int32
Dim Profit, DollarSum, DelinquentSum, SalesPrice As Double
Dim LTDemandDate, DepletionDate, DemandDate, PromisedDate As Date
Dim Critical As String
Dim ins As Boolean
PartCount = 0
DelinquentCount = 0
DelinquentSum = 0
DollarSum = 0
While drdGetData.Read
Material = drdGetData("MATERIAL")
Program = getProgram(Material, cnSQL2)
ExpireDate = getExpireDate(Material, cnSQL2)
'MinEOQ = getMinEOQ(Material, cnSQL2)
Stock = drdGetData("STOCK")
Dim returnDemand As Demand = New Demand(Material, StartDate, EndDate, cnSQL2)
Demand = returnDemand.Value
LTDemand = drdGetData("LTDEMAND")
SalesPrice = drdGetData("SALESPRICE")
PartCount = PartCount + 1
DollarSum = DollarSum + Demand * SalesPrice
NewestJob = drdGetData("JOB")
NewestJobQty = getJobQty(NewestJob, cnSQL2)
InProcess = drdGetData("INPROCESS")
LTAQty = drdGetData("LTAQTY")
Demand6Months = drdGetData("DEMAND6MONTHS")
Demand12Months = drdGetData("DEMAND12MONTHS")
LTDemandDate = drdGetData("LTDEMANDDATE")
DepletionDate = drdGetData("DEPLETIONDATE")
Profit = drdGetData("PROFIT")
LT = drdGetData("LT")
Dim returnDeliveries As Deliveries = New Deliveries(Material, StartDate, EndDate, cnSQL2)
Deliveries = returnDeliveries.Value
returnDeliveries = Nothing
Dim returnDemandDate As DemandDate = New DemandDate(Material, cnSQL2)
DemandDate = returnDemandDate.Value
returnDemandDate = Nothing
LTDemandDate = drdGetData("LTDEMANDDATE")
If DemandDate < Now Then
DelinquentCount = DelinquentCount + 1
DelinquentSum = DelinquentSum + Demand * SalesPrice
End If
Dim returnCritical As CriticalPart = New CriticalPart(Material, cnSQL2)
Critical = returnCritical.Critical
PersonResp = returnCritical.PersonResp
Comments = returnCritical.Comments
PromisedQty = returnCritical.Quantity
PromisedDate = IIf(IsDBNull(returnCritical.PromisedDate), Nothing, returnCritical.PromisedDate)
CriticalColor = IIf(IsDBNull(returnCritical.CriticalColor), Nothing, returnCritical.CriticalColor)
returnCritical = Nothing
Select Case ReportType
Case "PRODUCTIONCONTROL"
If Demand > Stock Then
ins = True
Else
ins = False
End If
Case "PRODUCTIONPLANNING"
If Demand > Stock + InProcess Then
ins = True
Else
ins = False
End If
Case "PRODUCTIONPLANNINGLT"
If InProcess + Stock < LTDemand Then
ins = True
Else
ins = False
End If
Case "CRITICAL"
If Critical = "YES" Then
ins = True
Else
ins = False
End If
End Select
If ins = True Then
insertdtPC(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, NewestJobQty, _
LT, ExpireDate, CriticalColor, Program)
End If
End While
Dim myrow As DataRow = dtReport.NewRow()
myrow("DELINQUENT_COUNT") = DelinquentCount
myrow("PART_COUNT") = PartCount
myrow("DOLLAR_SUM") = DollarSum
myrow("DELINQUENT_SUM") = DelinquentSum
myrow("START_DATE") = StartDate
myrow("END_DATE") = EndDate
dtReport.Rows.Add(myrow)
popdtPCSorted(ReportType, SortByPart)
drdGetData.Close()
End Sub
Function getProgram(Material As String, DBConnection As SqlConnection) As String
Dim strSQL As String
strSQL = "SELECT T2.TEXT2 "
strSQL &= "FROM MATERIAL T1, USER_VALUES T2 WHERE "
strSQL &= "T1.USER_VALUES = T2.USER_VALUES AND "
strSQL &= "T1.MATERIAL = #MATERIAL "
popdtParam(Material, "STRING", "MATERIAL")
Dim getValue As New getSingleValuePQ(strSQL, "TEXT2", "STRING", dtParam, DBConnection)
If getValue.Value = "NOTHING" Then
Return ""
Else
Return getValue.Value
End If
End Function
Function getExpireDate(ByVal Material As String, ByVal DBConnection As SqlConnection) As String
Dim strSQL As String
strSQL = "SELECT MAX(T1.PROMISED_DATE) AS EXPIRE_DATE "
strSQL &= "FROM SO_Header T1, SO_Detail T2 "
strSQL &= "WHERE "
strSQL &= "T1.Sales_Order = T2.Sales_Order AND "
strSQL &= "T1.Customer = 'GECO500' AND SUBSTRING(T1.CUSTOMER_PO,1,2) = '90' AND "
strSQL &= "T1.Status = 'Open' AND T2.Status = 'Open' AND "
strSQL &= "T2.Material = #MATERIAL "
popdtParam(Material, "STRING", "MATERIAL")
Dim getDate As New getSingleValuePQ(strSQL, "EXPIRE_DATE", "DATE", dtParam, DBConnection)
If getDate.Value = #1/1/1900# Then
getExpireDate = " "
Else
getExpireDate = Format(getDate.Value, "Short Date")
End If
End Function
Private Sub insertdtPC(ByVal Material As String, ByVal Stock As Int64, ByVal Demand As Int64, ByVal NewestJob As String, _
ByVal InProcess As Int64, ByVal LTAQty As Int64, ByVal Demand6Months As Int64, ByVal Demand12Months As Int64, _
ByVal LTDemandDate As Date, ByVal DepletionDate As Date, ByVal Deliveries As String, ByVal DemandDate As Date, ByVal Profit As Double, _
ByVal Critical As String, ByVal PersonResp As String, ByVal Comments As String, ByVal PromisedQty As Int64, ByVal PromisedDate As Date, ByVal LTDemand As Int64, _
ByVal NewestJobQty As Int64, ByVal LT As Int64, ByVal ExpireDate As String, CriticalColor As String, _
ByVal Program As String)
strsql = "SELECT JOB, MAKE_QUANTITY, COMPLETED_QUANTITY FROM JOB "
strsql &= "WHERE PART_NUMBER = '" + Material + "' AND STATUS = 'Active'"
Dim Job, Routing As String
Dim MakeQuantity, CompletedQuantity As Int32
Routing = Nothing
Dim drdGetData As SqlDataReader = Nothing
Dim cmmGetData As New SqlCommand(strsql, DB1)
Try
drdGetData = cmmGetData.ExecuteReader()
Catch objException As SqlException
Dim objerror As SqlError
For Each objerror In objException.Errors
MsgBox(objException.Message)
Next
End Try
Dim drdRead As Boolean = False
While drdGetData.Read
drdRead = True
Job = drdGetData("JOB")
MakeQuantity = drdGetData("MAKE_QUANTITY")
CompletedQuantity = drdGetData("COMPLETED_QUANTITY")
Dim returnRouting As RoutingString = New RoutingString(Job, DB2, DB3)
Routing = returnRouting.Value
returnRouting = Nothing
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPC, CriticalColor)
End While
If drdRead = False Then
Job = "NONE"
MakeQuantity = 0
CompletedQuantity = 0
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPC, CriticalColor)
End If
DB1.Close()
DB2.Close()
DB3.Close()
End Sub
Private Sub insertDTRecord(ByVal Material As String, ByVal Stock As Int64, ByVal Demand As Int64, ByVal NewestJob As String, ByVal InProcess As Int64, ByVal LTAQty As Int64, ByVal Demand6Months As Int64, _
ByVal Demand12Months As Int64, ByVal LTDemandDate As Date, ByVal DepletionDate As Date, ByVal Job As String, ByVal MakeQuantity As Int64, _
ByVal CompletedQuantity As Int64, ByVal Routing As String, ByVal Deliveries As String, ByVal DemandDate As Date, ByVal Profit As Double, _
ByVal Critical As String, ByVal PersonResp As String, ByVal Comments As String, ByVal PromisedQty As Int64, ByVal PromisedDate As Date, ByVal LTDemand As Int64, _
ByVal NewestJobQty As Int64, ByVal LT As String, Program As String, _
ByVal ExpireDate As String, ByVal myDatatable As DataTable, Optional CriticalColor As String = "BLACK", Optional ByVal SORT_ORDER As Integer = -1)
Dim myrow As DataRow = myDatatable.NewRow()
Dim minEOQ As Int64
minEOQ = getMinEOQ(Material, cnSQL2)
If Not IsDBNull(minEOQ) Then
If minEOQ <> 0 Then
myrow("MIN_EOQ") = minEOQ
End If
End If
myrow("MATERIAL") = Material
myrow("PROGRAM") = Program
myrow("STOCK") = Stock
myrow("DEMAND") = Demand
myrow("NEWEST_JOB") = NewestJob
myrow("IN_PROCESS") = InProcess
myrow("LTA_QUANTITY") = LTAQty
myrow("DEMAND_6MONTHS") = Demand6Months
myrow("DEMAND_12MONTHS") = Demand12Months
myrow("LT_DEMAND_DATE") = LTDemandDate
myrow("DEPLETION_DATE") = DepletionDate
myrow("JOB") = Job
myrow("MAKE_QUANTITY") = MakeQuantity
myrow("COMPLETED_QUANTITY") = CompletedQuantity
myrow("ROUTING") = Routing
myrow("DELIVERIES") = Deliveries
myrow("DEMAND_DATE") = DemandDate
myrow("PROFIT") = Profit
myrow("CRITICAL") = Critical
myrow("PERSON_RESP") = PersonResp
myrow("COMMENTS") = Comments
myrow("PROMISED_QUANTITY") = PromisedQty
If PromisedDate <> Nothing Then
myrow("PROMISED_DATE") = Convert.ToString(Format(PromisedDate, "M/d/yy"))
End If
myrow("LT_DEMAND") = LTDemand
myrow("NEWEST_JOB_QTY") = NewestJobQty
myrow("LT") = Convert.ToInt32(LT)
myrow("LT_DEMAND_DATE") = LTDemandDate
myrow("LTA_QUANTITY") = LTAQty
myrow("EXPIRE_DATE") = ExpireDate
myrow("COLOR") = CriticalColor
If SORT_ORDER <> -1 Then
myrow("SORT_ORDER") = SORT_ORDER
End If
myDatatable.Rows.Add(myrow)
End Sub
Private Sub orderdtPC()
Dim myRows As Array = dtPC.Select()
Dim i As Integer
For i = 0 To myRows.GetUpperBound(0)
myRows(i)("SORT_ORDER") = i
Next
End Sub
Private Sub mkdtReport()
' Create new DataColumn, set DataType, ColumnName and add to DataTable.
Private Sub mkdtPC()
' Create new DataColumn, set DataType, ColumnName and add to DataTable.
*** Removed some Dim statements to post ****
Dim myDataColumn7 As DataColumn = New DataColumn
myDataColumn7.DataType = System.Type.GetType("System.String")
myDataColumn7.ColumnName = "ROUTING"
myDataColumn7.ReadOnly = True
myDataColumn7.Unique = False
dtPCSorted.Columns.Add(myDataColumn7)
Dim myDataColumn8 As DataColumn = New DataColumn
myDataColumn8.DataType = System.Type.GetType("System.Int32")
myDataColumn8.ColumnName = "MAKE_QUANTITY"
myDataColumn8.ReadOnly = True
myDataColumn8.Unique = False
dtPCSorted.Columns.Add(myDataColumn8)
Dim myDataColumn88 As DataColumn = New DataColumn
myDataColumn88.DataType = System.Type.GetType("System.Int32")
myDataColumn88.ColumnName = "COMPLETED_QUANTITY"
myDataColumn88.ReadOnly = True
myDataColumn88.Unique = False
dtPCSorted.Columns.Add(myDataColumn88)
Dim myDataColumn9 As DataColumn = New DataColumn
myDataColumn9.DataType = System.Type.GetType("System.DateTime")
myDataColumn9.ColumnName = "DEMAND_DATE"
myDataColumn9.ReadOnly = True
myDataColumn9.Unique = False
dtPCSorted.Columns.Add(myDataColumn9)
Dim myDataColumn11 As DataColumn = New DataColumn
myDataColumn11.DataType = System.Type.GetType("System.String")
myDataColumn11.ColumnName = "CRITICAL"
myDataColumn11.ReadOnly = True
myDataColumn11.Unique = False
dtPCSorted.Columns.Add(myDataColumn11)
Dim myDataColumn12 As DataColumn = New DataColumn
myDataColumn12.DataType = System.Type.GetType("System.DateTime")
myDataColumn12.ColumnName = "PROMISED_DATE"
myDataColumn12.ReadOnly = True
myDataColumn12.Unique = False
dtPCSorted.Columns.Add(myDataColumn12)
Dim myDataColumn13 As DataColumn = New DataColumn
myDataColumn13.DataType = System.Type.GetType("System.Int32")
myDataColumn13.ColumnName = "PROMISED_QUANTITY"
myDataColumn13.ReadOnly = True
myDataColumn13.Unique = False
dtPCSorted.Columns.Add(myDataColumn13)
Dim myDataColumn14 As DataColumn = New DataColumn
myDataColumn14.DataType = System.Type.GetType("System.String")
myDataColumn14.ColumnName = "COMMENTS"
myDataColumn14.ReadOnly = True
myDataColumn14.Unique = False
dtPCSorted.Columns.Add(myDataColumn14)
Dim myDataColumn15 As DataColumn = New DataColumn
myDataColumn15.DataType = System.Type.GetType("System.String")
myDataColumn15.ColumnName = "PERSON_RESP"
myDataColumn15.ReadOnly = True
myDataColumn15.Unique = False
dtPCSorted.Columns.Add(myDataColumn15)
Dim myDataColumn16 As DataColumn = New DataColumn
myDataColumn16.DataType = System.Type.GetType("System.Int32")
myDataColumn16.ColumnName = "LTA_QUANTITY"
myDataColumn16.ReadOnly = True
myDataColumn16.Unique = False
dtPCSorted.Columns.Add(myDataColumn16)
Dim myDataColumn17 As DataColumn = New DataColumn
myDataColumn17.DataType = System.Type.GetType("System.DateTime")
myDataColumn17.ColumnName = "LT_DEMAND_DATE"
myDataColumn17.ReadOnly = True
myDataColumn17.Unique = False
dtPCSorted.Columns.Add(myDataColumn17)
Dim myDataColumn18 As DataColumn = New DataColumn
myDataColumn18.DataType = System.Type.GetType("System.Int32")
myDataColumn18.ColumnName = "LT_DEMAND"
myDataColumn18.ReadOnly = True
myDataColumn18.Unique = False
dtPCSorted.Columns.Add(myDataColumn18)
Dim myDataColumn19 As DataColumn = New DataColumn
myDataColumn19.DataType = System.Type.GetType("System.String")
myDataColumn19.ColumnName = "NEWEST_JOB"
myDataColumn19.ReadOnly = True
myDataColumn19.Unique = False
dtPCSorted.Columns.Add(myDataColumn19)
Dim myDataColumn20 As DataColumn = New DataColumn
myDataColumn20.DataType = System.Type.GetType("System.Double")
myDataColumn20.ColumnName = "PROFIT"
myDataColumn20.ReadOnly = True
myDataColumn20.Unique = False
dtPCSorted.Columns.Add(myDataColumn20)
Dim myDataColumn21 As DataColumn = New DataColumn
myDataColumn21.DataType = System.Type.GetType("System.Int32")
myDataColumn21.ColumnName = "DEMAND_6MONTHS"
myDataColumn21.ReadOnly = True
myDataColumn21.Unique = False
dtPCSorted.Columns.Add(myDataColumn21)
Dim myDataColumn22 As DataColumn = New DataColumn
myDataColumn22.DataType = System.Type.GetType("System.Int32")
myDataColumn22.ColumnName = "DEMAND_12MONTHS"
myDataColumn22.ReadOnly = True
myDataColumn22.Unique = False
dtPCSorted.Columns.Add(myDataColumn22)
Dim myDataColumn23 As DataColumn = New DataColumn
myDataColumn23.DataType = System.Type.GetType("System.Int32")
myDataColumn23.ColumnName = "NEWEST_JOB_QTY"
myDataColumn23.ReadOnly = True
myDataColumn23.Unique = False
dtPCSorted.Columns.Add(myDataColumn23)
Dim myDataColumn24 As DataColumn = New DataColumn
myDataColumn24.DataType = System.Type.GetType("System.String")
myDataColumn24.ColumnName = "LT"
myDataColumn24.ReadOnly = True
myDataColumn24.Unique = False
dtPCSorted.Columns.Add(myDataColumn24)
Dim myDataColumn25 As DataColumn = New DataColumn
myDataColumn25.DataType = System.Type.GetType("System.Double")
myDataColumn25.ColumnName = "MIN_EOQ"
myDataColumn25.ReadOnly = True
myDataColumn25.Unique = False
dtPCSorted.Columns.Add(myDataColumn25)
Dim myDataColumn26 As DataColumn = New DataColumn
myDataColumn26.DataType = System.Type.GetType("System.String")
myDataColumn26.ColumnName = "EXPIRE_DATE"
myDataColumn26.ReadOnly = True
myDataColumn26.Unique = False
dtPCSorted.Columns.Add(myDataColumn26)
Dim myDataColumn27 As DataColumn = New DataColumn
myDataColumn27.DataType = System.Type.GetType("System.String")
myDataColumn27.ColumnName = "PROGRAM"
myDataColumn27.ReadOnly = True
myDataColumn27.Unique = False
dtPCSorted.Columns.Add(myDataColumn27)
'Dim PrimaryKeyColumns(1) As DataColumn
'PrimaryKeyColumns(0) = dtPCSorted.Columns("SORT_ORDER")
'dtPCSorted.PrimaryKey = PrimaryKeyColumns
End Sub
Private Sub popdtPCSorted(ByVal ReportType As String, SortbyPart As Boolean)
Dim PCDV As DataView
dtPCSorted.Clear()
Select Case ReportType
Case "CRITICAL"
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Case "PRODUCTIONPLANNINGLT"
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"DEPLETION_DATE, MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Case Else
If SortbyPart = False Then
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"DEMAND_DATE, MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Else
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"MATERIAL, DEMAND_DATE, JOB", _
DataViewRowState.CurrentRows)
End If
End Select
Dim myDRV As DataRowView
Dim i, InProcess, LT, Stock, Demand, LTAQty, Demand6Months, Demand12Months, _
MakeQuantity, CompletedQuantity, PromisedQty, NewestJobQty, LTDemand As Int64
Dim Profit, MinEOQ As Double
Dim Material, NewestJob, Job, Routing, Deliveries, PersonResp, Comments, Critical, ExpireDate, CriticalColor, Program As String
Dim LTDemandDate, DepletionDate, PromisedDate, DemandDate As Date
i = 1
For Each myDRV In PCDV
Material = myDRV("MATERIAL")
Program = myDRV("PROGRAM")
CriticalColor = IIf(IsDBNull(myDRV("COLOR")), "BLACK", myDRV("COLOR"))
If Not IsDBNull(myDRV("MIN_EOQ")) Then
MinEOQ = myDRV("MIN_EOQ")
End If
Demand = myDRV("DEMAND")
Stock = myDRV("STOCK")
NewestJob = myDRV("NEWEST_JOB")
InProcess = myDRV("IN_PROCESS")
LTAQty = myDRV("LTA_QUANTITY")
Demand6Months = myDRV("DEMAND_6MONTHS")
Demand12Months = myDRV("DEMAND_12MONTHS")
LTDemandDate = myDRV("LT_DEMAND_DATE")
ExpireDate = myDRV("EXPIRE_DATE")
If ReportType = "CRITICAL" Then
DepletionDate = myDRV("DEMAND_DATE")
Else
DepletionDate = myDRV("DEPLETION_DATE")
End If
Job = myDRV("JOB")
MakeQuantity = myDRV("MAKE_QUANTITY")
CompletedQuantity = myDRV("COMPLETED_QUANTITY")
If IsDBNull(myDRV("ROUTING")) Then
Routing = " "
Else
Routing = myDRV("ROUTING")
End If
Deliveries = myDRV("DELIVERIES")
DemandDate = myDRV("DEMAND_DATE")
Profit = myDRV("PROFIT")
Critical = myDRV("CRITICAL")
If IsDBNull(myDRV("PERSON_RESP")) Then
PersonResp = "X"
Else
PersonResp = myDRV("PERSON_RESP")
End If
If IsDBNull(myDRV("COMMENTS")) Then
Comments = "X"
Else
Comments = myDRV("COMMENTS")
End If
PromisedQty = myDRV("PROMISED_QUANTITY")
If IsDBNull(myDRV("PROMISED_DATE")) Then
PromisedDate = Nothing
Else
PromisedDate = myDRV("PROMISED_DATE")
End If
LTDemand = myDRV("LT_DEMAND")
NewestJobQty = myDRV("NEWEST_JOB_QTY")
LT = myDRV("LT")
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPCSorted, CriticalColor, i)
i = i + 1
Next
myDRV = Nothing
End Sub
Function getSortDate(ByVal inDate As Date) As Date
Dim strYear, strMonth, strDay As String
strYear = Trim(Str(DatePart(DateInterval.Year, inDate)))
Dim numMonth As Int64 = DatePart(DateInterval.Month, inDate)
Dim numDay As Int64 = DatePart(DateInterval.Day, inDate)
If numMonth < 10 Then
strMonth = "0" & Trim(Str(numMonth))
Else
strMonth = Trim(Str(numMonth))
End If
If numDay < 10 Then
strDay = "0" & Trim(Str(numDay))
Else
strDay = Trim(Str(numDay))
End If
getSortDate = strYear & strMonth & strDay
End Function
Private Sub btnrptProductionControl_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnrptProductionControl.Click
Dim sortByPart As Boolean
If cbSortByPart.Checked Then
sortByPart = True
Else
sortByPart = False
End If
Dim tStartDate As String = txtStartDate.Text
Dim tEndDate As String = txtEndDate.Text
dsPC.Clear()
If tStartDate = "" Or tEndDate = "" Then
MsgBox("Please enter valid start and end dates.")
Else
If Not IsDate(tStartDate) Or Not IsDate(tEndDate) Then
MsgBox("Please enter valid start and stop dates.")
Else
popdtPC(Convert.ToDateTime(tStartDate), Convert.ToDateTime(tEndDate), "PRODUCTIONCONTROL", sortByPart)
Dim myfrm As New afrmReportPreview(afrmReportPreview.ReportType.rptProductionControl, dsPC)
myfrm.ShowDialog()
End If
End If
End Sub
Related
I am attempting to convert code to ADO.Net and I am running into an error on updating. Here is the old code:
Private Sub TrackStandardUnit(ByVal iMode As Short, ByVal sSpecies As String, ByVal sProdDesc As String, ByVal sLength As String, ByVal sMultiLgth As String, ByVal sGrades As String, ByVal sCure As String, ByVal sSurface As String, ByVal sThick As String, ByVal sWidth As String, ByVal sgUnits As Single, ByVal iFtg As Short, ByVal iPcs As Short, ByVal iStdPcs As Short, ByVal iStdFtg As Short)
Dim sNewProd As String
If Len(sGrades) = 3 Then
sNewProd = sProdDesc
Else
sNewProd = $"{Mid(sProdDesc, 1, 2)}({Strings.Left(sGrades, Len(sGrades) - 1)}){Mid(sProdDesc, 5)}"
End If
Dim sSql As String = $"SELECT * FROM tblStdUnitTracking WHERE Species = '{sSpecies}' AND ProdDesc = '{sProdDesc}' AND StdUnits = {sgUnits}"
Dim bLgths As Boolean = StdUnitLgthUsed(sThick, sWidth, sSpecies, sGrades, sCure, sSurface) ' Lengths present in std unit file
If bLgths = True Then ' If lengths present in std unit file
sSql = $"{sSql} AND Length = '{sLength}' AND MultiLgth = '{sMultiLgth}'"
End If
Dim rsUnit As ADODB.Recordset = NewRs()
OpenRsOptimistic(sSql, rsUnit)
If rsUnit.RecordCount = 0 Then
rsUnit.AddNew()
rsUnit.Fields("Species").Value = sSpecies
rsUnit.Fields("ProdDesc").Value = sNewProd
rsUnit.Fields("StdUnits").Value = sgUnits
If sgUnits = 0 Then
rsUnit.Fields("PieceCnt").Value = 0
ElseIf iStdPcs > 0 Then
rsUnit.Fields("StdPieceCnt").Value = iStdPcs
rsUnit.Fields("StdFootage").Value = 0
rsUnit.Fields("PieceCnt").Value = iPcs
ElseIf iStdFtg > 0 Then
rsUnit.Fields("StdFootage").Value = iStdFtg
rsUnit.Fields("StdPieceCnt").Value = 0
rsUnit.Fields("PieceCnt").Value = 0
End If
If bLgths = True Then ' If lengths present in std unit file
rsUnit.Fields("Length").Value = sLength ' Save length info
rsUnit.Fields("MultiLgth").Value = sMultiLgth
Else ' Else - no lengths
rsUnit.Fields("Length").Value = ""
rsUnit.Fields("MultiLgth").Value = ""
End If
End If
rsUnit.Fields("Count").Value = rsUnit.Fields("Count").Value + 1
Try
rsUnit.Update()
rsUnit.Close()
Catch ex As Exception
End Try
End Sub
Here is the new code:
Private Sub TrackStandardUnit(ByVal iMode As Short, ByVal sSpecies As String, ByVal sProdDesc As String, ByVal sLength As String, ByVal sMultiLgth As String, ByVal sGrades As String, ByVal sCure As String, ByVal sSurface As String, ByVal sThick As String, ByVal sWidth As String, ByVal sgUnits As Single, ByVal iFtg As Short, ByVal iPcs As Short, ByVal iStdPcs As Short, ByVal iStdFtg As Short)
Dim sNewProd As String
If Len(sGrades) = 3 Then
sNewProd = sProdDesc
Else
sNewProd = $"{Mid(sProdDesc, 1, 2)}({Strings.Left(sGrades, Len(sGrades) - 1)}){Mid(sProdDesc, 5)}"
End If
Dim sSql As String = $"SELECT * FROM tblStdUnitTracking WHERE Species = '{sSpecies}' AND ProdDesc = '{sProdDesc}' AND StdUnits = {sgUnits}"
Dim bLgths As Boolean = StdUnitLgthUsed(sThick, sWidth, sSpecies, sGrades, sCure, sSurface) ' Lengths present in std unit file
If bLgths = True Then ' If lengths present in std unit file
sSql = $"{sSql} AND Length = '{sLength}' AND MultiLgth = '{sMultiLgth}'"
End If
Dim dtUni As New DataTable
Dim constring As String = GetDbConnectionString(gDataPath & "Lisa.mdb", "")
Dim con As OleDbConnection = GetOleDBConnection(constring)
Dim cmd As OleDbCommand = GetOleDBCommand(sSql, con)
Dim daX As New OleDbDataAdapter(cmd)
con.Open()
daX.Fill(dtUni)
ds.Tables.Add(dtUni)
dtUni.TableName = ("AddStdUnit")
con.Close()
Dim dtBuilder As New OleDbCommandBuilder(daX)
dtBuilder.GetUpdateCommand()
daX.UpdateCommand = dtBuilder.GetUpdateCommand()
Dim r As DataRow = dtUni.NewRow
If dtUni.Rows.Count = 0 Then
r("Species") = sSpecies
r("ProdDesc") = sNewProd
r("StdUnits") = sgUnits
r("Footage") = 0
If sgUnits = 0 Then
r("PieceCnt") = 0
ElseIf iStdPcs > 0 Then
r("StdPieceCnt") = iStdPcs
r("StdFootage") = 0
r("PieceCnt") = iPcs
ElseIf iStdFtg > 0 Then
r("StdFootage") = iStdFtg
r("StdPieceCnt") = 0
r("PieceCnt") = 0
End If
If bLgths = True Then ' If lengths present in std unit file
r("Length") = sLength ' Save length info
r("MultiLgth") = sMultiLgth
Else ' Else - no lengths
r("Length") = "0"
r("MultiLgth") = "0"
End If ' THIS IS WHERE YOU STOPPED, IT IS NOT UPDATING TO THE MDB BELOW!!!!!!!!!!!!!!!
End If
If IsDBNull(r("Count")) = True Then
r("Count") = 0
Else
r("Count") += 1
End If
Try
dtUni.Rows.Add(r)
daX.AcceptChangesDuringUpdate = True
daX.Update(ds, "AddStdUnit")
Catch ex As Exception
MsgBox(ex.Message)
End Try
ds.Tables.Remove("AddStdUnit")
End Sub
Getting an "Invalid Insert Syntax" at "daX.Update(ds, "AddStdUnit")" and when I check the "daX.UpdateCommand.CommandText" all the values are "?" but when I view the table data in "dtUni" the row was added and populated, it just won't update to the actual database with the updatecommand.
What am I doing wrong here?
Here are the CommandTexts for insert and update right before daX.Update(ds, "AddStdUnit") is called:
?dax.UpdateCommand.CommandText
"UPDATE tblStdUnitTracking SET Species = ?, ProdDesc = ?, Length = ?, MultiLgth = ?, StdUnits = ?, StdFootage = ?, StdPieceCnt = ?, PieceCnt = ?, Footage = ?, Count = ? WHERE ((Species = ?) AND (ProdDesc = ?) AND (Length = ?) AND (MultiLgth = ?) AND (StdUnits = ?) AND (StdFootage = ?) AND (StdPieceCnt = ?) AND (PieceCnt = ?) AND ((? = 1 AND Footage IS NULL) OR (Footage = ?)) AND ((? = 1 AND Count IS NULL) OR (Count = ?)))"
?dax.InsertCommand.CommandText
"INSERT INTO tblStdUnitTracking (Species, ProdDesc, Length, MultiLgth, StdUnits, StdFootage, StdPieceCnt, PieceCnt, Footage, Count) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
Notice all the "?'s".
And here is the DataTable Visualizer of dtUni right before the update command is called: datatable visualizer
There was way too much code in a single method doing too many different things.
The button code deals strictly with the user interface. I have declared all the variables. I don't know where the values for these come from so I just added a default value. The button calls the various methods and displays message boxes for errors.
Database objects like connections, commands and data adapter need to be disposed. Using...End Using blocks handle this. You can dispose the DataAdapter after you are finished with it.
Always use Parameters to avoid Sql injection. I had to guess at the datatypes of the parameters. Check your database for the correct types.
The DataAdapter will open and close the connection. I didn't see the need for a DataSet or a name for the DataTable.
Private constring As String = GetDbConnectionString(gDataPath & "Lisa.mdb", ""))
Private daX As OleDbDataAdapter
Private dt As DataTable
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim sThick As String = ""
Dim sWidth As String = ""
Dim sSpecies As String = ""
Dim sGrades As String = ""
Dim sCure As String = ""
Dim sSurface As String = ""
Dim sProdDesc As String = ""
Dim sgUnits As Single = 0
Dim sLength As String = ""
Dim sMultiLgth As String = ""
Dim iFtg As Short = 0
Dim iPcs As Short = 0
Dim iStdPcs As Short = 0
Dim iStdFtg As Short = 0
Dim bLgths As Boolean = StdUnitLgthUsed(sThick, sWidth, sSpecies, sGrades, sCure, sSurface) ' Lengths present in std unit file
Try
FillDataTable(bLgths, sSpecies, sProdDesc, sgUnits, sLength, sMultiLgth)
Catch ex As Exception
MessageBox.Show(ex.Message,"Error Filling DataTable")
Exit Sub
End Try
Dim sNewProd As String
If sGrades.Length = 3 Then
sNewProd = sProdDesc
Else
sNewProd = $"{sProdDesc.Substring(0, 2)}({sGrades.Substring(0, sGrades.Length - 1)}){sProdDesc.Substring(5)}"
End If
AddRowtoDataTable(sSpecies, sProdDesc, sGrades, sNewProd, sgUnits,iStdPcs,iPcs,iStdFtg,bLgths,sLength,sMultiLgth)
Try
UpdateDatabase()
Catch ex As Exception
MessageBox.Show(ex.Message, "Error Updating Database")
End Try
End Sub
Private Sub FillDataTable(bLgths As Boolean, sSpecies As String, sProdDesc As String, sgUnits As Single, sLength As String, sMultiLgth As String) As DataTable
Dim sSql As String = $"SELECT * FROM tblStdUnitTracking WHERE Species = #Species
AND ProdDesc = #ProdDesc
AND StdUnits = #Units"
dt = New DataTable
Using con As New OleDbConnection(constring),
cmd As New OleDbCommand()
With cmd.Parameters
.Add("#Species", OleDbType.VarChar).Value = sSpecies
.Add("#ProdDesc", OleDbType.VarChar).Value = sProdDesc
.Add("#Units", OleDbType.SmallInt).Value = sgUnits
End With
If bLgths Then ' If lengths present in std unit file
sSql &= $" AND Length = #Length AND MultiLgth = #MultiLgth"
cmd.Parameters.Add("#Length", OleDbType.VarChar).Value = sLength
cmd.Parameters.Add("#MultiLgth", OleDbType.VarChar).Value = sMultiLgth
End If
sSql &= ";"
cmd.CommandText = sSql
cmd.Connection = con
daX = New OleDbDataAdapter(cmd)
daX.Fill(dt)
End Using
End Sub
Private Sub AddRowtoDataTable(sSpecies As String, sProdDesc As String, sGrades As String, sNewProd As String, sgUnits As Single, iStdPcs As Integer, iPcs As Integer, iStdFtg As Integer, bLgths As Boolean, sLength As String, sMultiLgth As String)
Dim r As DataRow = dt.NewRow
If dt.Rows.Count = 0 Then
r("Species") = sSpecies
r("ProdDesc") = sNewProd
r("StdUnits") = sgUnits
r("Footage") = 0
If sgUnits = 0 Then
r("PieceCnt") = 0
ElseIf iStdPcs > 0 Then
r("StdPieceCnt") = iStdPcs
r("StdFootage") = 0
r("PieceCnt") = iPcs
ElseIf iStdFtg > 0 Then
r("StdFootage") = iStdFtg
r("StdPieceCnt") = 0
r("PieceCnt") = 0
End If
If bLgths Then ' If lengths present in std unit file
r("Length") = sLength ' Save length info
r("MultiLgth") = sMultiLgth
Else ' Else - no lengths
r("Length") = "0"
r("MultiLgth") = "0"
End If ' THIS IS WHERE YOU STOPPED, IT IS NOT UPDATING TO THE MDB BELOW!!!!!!!!!!!!!!!
End If
r("Count") = 0 'The If statement is useless, this is a New Row with no value set for Count.
dt.Rows.Add(r) 'Adding a blank row if rows.count =0
End Sub
Private Sub UpdateDatabase()
Using dtBuilder As New OleDbCommandBuilder(daX)
dtBuilder.GetUpdateCommand()
daX.UpdateCommand = dtBuilder.GetUpdateCommand()
Try
daX.AcceptChangesDuringUpdate = True
daX.Update(dt)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Using
End Sub
I think there are way too many parameters being passed. If you could create a class the models you database fields it would be easy to pass a single object with all its properties. Intellisense is helpful here.
Your problem looks to be that you using commandBuilder, and ONLY getting the update command - you need the insert command.
Just ONLY create the command builder - it will and should build all 3 for you automatic (insert, update, delete)
Also, command builder has a reader, and a connection, so no need to make more.
In fact, with a reader, and NOT needing up todate, then do NOT create a data adaptor.
Go this way:
Dim dtUni As New DataTable
Using cmd As New OleDbCommand(Sql,
New OleDbConnection(GetDBConnectionString(gDataPath & "Lisa.mdb", "")))
cmd.Connection.Open()
dtUni.Load(cmd.ExecuteReader)
End Using
So you only need a "adaptor" if you going to update the data - which is your case.
So, try this:
Dim dtUni As New DataTable
Using cmd As New OleDbCommand(Sql,
New OleDbConnection(GetDBConnectionString(gDataPath & "Lisa.mdb", "")))
cmd.Connection.Open()
dtUni.Load(cmd.ExecuteReader)
Dim daX As New OleDbDataAdapter(cmd)
Dim dtBuilder As New OleDbCommandBuilder(daX)
cmd.Connection.Open()
daX.Fill(dtUni)
ds.Tables.Add(dtUni)
dtUni.TableName = ("AddStdUnit")
cmd.Connection.Close()
Dim r As DataRow = dtUni.NewRow
' your code here, then
Try
cmd.Connection.Open()
dtUni.Rows.Add(r)
daX.AcceptChangesDuringUpdate = True
daX.Update(dtUni) '<---- just table here.
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Using
ds.Tables.Remove("AddStdUnit")
I am not sure if you need to close, and then re-open (but try it either way).
So, you are grabbing only the "update" command from command builder. (don't need to - just let command builder build as per above, and you can then EITHER update, insert rows into that data table, and the one daX.Update(dtUni) should work.
The ? placeholders are correct for OleDb. This is how parameterized queries work for OleDb (other providers have an even better mechanism using named parameters). The ? is a placeholder for the final value, which is NEVER substituted into the sql command string, even on the database itself. The values are kept in a separate place as variables, almost as if you'd written a stored procedure. In this way, any possibility of sql injection is prevented.
I don't know if this will help your issue, but I did go through the code and made a few changes as I went to match newer practices, and this often seems to help quite a bit. Specifically, I did spot a mistake around how the new row is added to the dataset that would result in always setting Count to zero. Otherwise, I tend not to use CommandBuilder or DataSet.Update() personally, and instead build INSERT or UPDATE statements in code (with valid query parameters) as appropriate.
Private Sub TrackStandardUnit(ByVal Mode As Short, ByVal Species As String, ByVal ProdDesc As String, ByVal Length As String, ByVal MultiLgth As String, ByVal Grades As String, ByVal Cure As String, ByVal Surface As String, ByVal Thick As String, ByVal Width As String, ByVal Units As Single, ByVal Ftg As Short, ByVal Pcs As Short, ByVal StdPcs As Short, ByVal StdFtg As Short)
Dim NewProd As String = ProdDesc
If Grades.Length <> 3 Then
NewProd = $"{ProdDesc.SubString(1, 2)}({Grades.Left(Grades.Length -1)}){ProdDesc.SubString(5)}"
End If
Dim sql As String = "SELECT * FROM tblStdUnitTracking WHERE Species = ? AND ProdDesc = ? AND StdUnits = ?"
Dim Lgths As Boolean = StdUnitLgthUsed(Thick, Width, Species, Grades, Cure, Surface) ' Lengths present in std unit file
If Lgths Then ' If lengths present in std unit file
sql += " AND Length = ? AND MultiLgth = ?"
End If
Dim ds As New DataSet
Dim constring As String = GetDbConnectionString(gDataPath & "Lisa.mdb", "")
Using con As OleDbConnection = GetOleDBConnection(constring), _
cmd As New OleDbCommand(sql, con), _
da As New OleDbDataAdapter(cmd)
' OleDb uses positional parameters. They work in the order they are found in the string
' I have to guess at parameter types and lengths. You should use the exact types from the database.
cmd.Parameters.Add("?", OleDbType.VarWChar, 30).Value = Species
cmd.Parameters.Add("?", OleDbType.VarWChar, 120).Value = ProdDesc
cmd.Parameters.Add("?", OleDbType.Single).Value = StdUnits
If Lgths Then
cmd.Parameters.Add("?", OleDbType.Integer).Value = Convert.ToInt32(Length)
cmd.Parameters.Add("?", OleDbType.Integer).Value = Convert.ToInt32(MultiLgth)
End If
da.Fill(ds)
Dim Uni As DataTable = ds.Tables(0)
Dim Builder As New OleDbCommandBuilder(da)
da.UpdateCommand = Builder.GetUpdateCommand()
If Uni.Rows.Count = 0 Then
Dim r As DataRow = Uni.NewRow
r("Species") = Species
r("ProdDesc") = NewProd
r("StdUnits") = Units
r("Footage") = 0
If sgUnits = 0 Then
r("PieceCnt") = 0
ElseIf iStdPcs > 0 Then
r("StdPieceCnt") = StdPcs
r("StdFootage") = 0
r("PieceCnt") = Pcs
ElseIf iStdFtg > 0 Then
r("StdFootage") = StdFtg
r("StdPieceCnt") = 0
r("PieceCnt") = 0
End If
If Lgths Then
r("Length") = Length
r("MultiLgth") = MultiLgth
Else
r("Length") = "0"
r("MultiLgth") = "0"
End If
Uni.Rows.Add(r)
End If
Dim row As DataRow = Uni.Rows(0)
If IsDBNull(row("Count")) Then
row("Count") = 0
Else
row("Count") += 1
End If
Try
da.AcceptChangesDuringUpdate = True
con.Open()
da.Update(ds)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Using
End Sub
"Count" is a reserved word which was throwing the invalid INSERT syntax when trying to use the daX.update command. Changed the field and all references to "xCount" and the ADO.Net code version above worked just fine. A commenter who deleted his comment for some reason is the one to thank for this answer.
Hi i need anyone to help me,
I need to highlight the highest value from multiple column in table
For Ex:-
I have try out some coding..
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
UIUtility = New UIUtility()
Dim dtStartProcessTime As DateTime
Dim dtEndProcessTime As DateTime
Dim dtStartQueryTime As DateTime
Dim dtEndQueryTime As DateTime
Dim tsQueryTime As TimeSpan
Dim tsProcessTime As TimeSpan
Dim strCassList As String = ""
Dim dtDefectInfo As New DataTable
Dim dtDefectList As New DataTable
Dim dtResult As New DataTable
Dim dtSelectDefectInfo As New DataTable
Dim strCass_id As String = ""
Dim dtDisplay As New DataTable
Try
dtStartProcessTime = Now
Me.Title = "Shipping Cassettes List"
Dim sEvent_date As String = Request.QueryString("Event_date").Trim()
Dim sRecipe As String = Request.QueryString("recipe").Trim()
Dim sOperation As String = Request.QueryString("operation").Trim()
Dim sEquipment As String = Request.QueryString("equipment").Trim()
lblStatus.Text = "Event_date:" + sEvent_date + _
"<br>Recipe:" + sRecipe + _
"<br>Operation:" + sOperation + _
"<br>Equipment:" + sEquipment + _
"<br><br>"
Dim dtCass As DataTable
Dim drNew As DataRow
Dim SelectDefectInfo As DataRow()
dtStartQueryTime = Now
dtCass = UIUtility.RetrieveShipCassette(sEvent_date, sRecipe, sOperation, sEquipment)
If dtCass.Rows.Count > 0 Then
strCassList = UIUtility.ReturnStringFromdt(dtCass, "shipping_cass_id")
dtDefectInfo = UIUtility.RetrieveDefectInfo(strCassList)
dtDefectList = UIUtility.dtView(dtDefectInfo, "defect")
dtResult.Columns.Add("cass_id", Type.GetType("System.String"))
For i = 0 To dtDefectList.Rows.Count - 1
If Not (dtDefectList.Rows(i).Item("defect").ToString().Equals("NON")) Then
dtResult.Columns.Add(dtDefectList.Rows(i).Item("defect"), Type.GetType("System.Int32")).DefaultValue = 0
End If
Next
For i = 0 To dtCass.Rows.Count - 1
drNew = dtResult.NewRow
strCass_id = dtCass.Rows(i).Item("shipping_cass_id")
drNew("cass_id") = dtCass.Rows(i).Item("cass_id")
SelectDefectInfo = dtDefectInfo.Select("dest_cass_id = '" + strCass_id + "'")
dtSelectDefectInfo = New DataTable
If SelectDefectInfo.Count > 0 Then
dtSelectDefectInfo = SelectDefectInfo.CopyToDataTable
For j = 0 To dtSelectDefectInfo.Rows.Count - 1
If Not (dtSelectDefectInfo.Rows(j).Item("defect").ToString().Trim().Equals("NON")) Then
drNew(dtSelectDefectInfo.Rows(j).Item("defect").ToString()) = dtSelectDefectInfo.Rows(j).Item("defect_count").ToString()
End If
Next
End If
dtResult.Rows.Add(drNew)
Next
End If
dtEndQueryTime = Now
tsQueryTime = dtEndQueryTime.Subtract(dtStartQueryTime)
'For i As Integer = 0 To dtCass.Rows.Count - 1
' drDisplay = dtDisplay.NewRow
' drDisplay("cass_id") = dtCass.Rows(i)("cass_id").ToString()
' dtDisplay.Rows.Add(drDisplay)
' 'dtCass.Rows(i).Item(
'Next
'e.Row.BorderWidth = 2
dgSummary.DataSource = Nothing
dgSummary.DataSource = dtResult
dgSummary.DataBind()
lblStatus.Text += "Total " + dtResult.Rows.Count.ToString + " rows of data found."
dtEndProcessTime = Now
tsProcessTime = dtEndProcessTime.Subtract(dtStartProcessTime)
lblProcessingTime.Text = "Processing Time: " + tsProcessTime.TotalSeconds.ToString + " Secs (Query Time: " + tsQueryTime.TotalSeconds.ToString + " Secs)"
For Each r As GridViewRow In dtResult.Rows()
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Text, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Text = max Then
r.Cells(i).BackColor = Drawing.Color.Orange
Exit For
End If
Next
Next
Catch ex As Exception
lblMessage.Text = "An error occured:" + ex.Message + " Please contact your administrator."
MyLog.WriteToLog(Me.GetType().Name(), System.Reflection.MethodInfo.GetCurrentMethod().Name, "Exception occured." & vbCrLf & "Error Message:" & ex.Message & vbCrLf & " StackTrace:" & ex.StackTrace)
End Try
End Sub
Protected Sub dgSummary_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles dgSummary.RowDataBound
Dim cass_id As String = ""
'Dim dtResult As New DataTable
'Dim DataGridView1 As New DataTable
Dim dtCass As New DataTable
If e.Row.RowType = DataControlRowType.DataRow Then
cass_id = e.Row.Cells(0).Text.Trim
If Not e.Row.Cells(0).Text.Trim.Equals("") Then
e.Row.Cells(0).Attributes.Add("Title", "Click and view the cassette details")
e.Row.Cells(0).Attributes("onmouseover") = "this.style.color='DodgerBlue';this.style.cursor='hand';"
e.Row.Cells(0).Attributes("onmouseout") = "this.style.color='Black';"
e.Row.Cells(0).Attributes("onClick") = _
String.Format("window.open('{0}','_blank','scrollbars=yes,status=yes,location=yes,toolbar=yes,menubar=yes,resizable=Yes')", _
ResolveUrl(System.Configuration.ConfigurationManager.AppSettings("SFEHReportLink_SSL") + cass_id))
e.Row.Cells(0).Style("cursor") = "pointer"
End If
End Sub
Maybe theres any coding that more easier than this since i have 17items
Thank you so much for you guys help.
After i add the new code, i got this error,
new error
maybe this example can help you
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
For Each r As DataGridViewRow In DataGridView1.Rows
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Value, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Value = max Then
r.Cells(i).Style.BackColor = Color.Orange
Exit For
End If
Next
Next
End Sub
Error: error line 369
Line 367: For intTeller = 0 To tblData.Rows.Count - 1
Line 368: With tblData.Rows(intTeller)
Line 369: .Item("Projected") = .Item("Sales") + .Item("ShippedNotInvoiced") + .Item("OpenOrdersCurrentPeriod")
Line 370: End With
Line 371: Next
Code
Imports System.Data.SqlClient
Partial Class Sales
Inherits System.Web.UI.Page
Dim tblData As New Data.DataTable
Private Sub DataGridToExcel(ByRef grdExport As GridView, ByRef pResponse As Web.HttpResponse, ByVal pFileName As String)
Try
Dim intTeller As Integer = 0
Dim strTemp As String
pResponse.Clear()
pResponse.AddHeader("content-disposition", "attachment;filename=" & pFileName)
pResponse.Buffer = True
pResponse.ContentType = "application/vnd.ms-excel"
pResponse.Charset = ""
Dim stringWrite As New System.IO.StringWriter
Dim htmlWrite As New System.Web.UI.HtmlTextWriter(stringWrite)
grdExport.RenderControl(htmlWrite)
strTemp = stringWrite.ToString
strTemp.Replace(",", "")
strTemp.Replace(".", "")
pResponse.Write(strTemp)
pResponse.End()
Catch ex As Exception
'Me.lblError.Text = ex.Message
End Try
End Sub
Public Overrides Sub VerifyRenderingInServerForm(ByVal control As Control)
End Sub
Private Sub sExportGrid()
DataGridToExcel(Me.grdSalesLines, Response, "Sales " & Format(Now, "yyyyMM") & ".xls")
End Sub
Protected Sub Page_Load(sender As Object, e As System.EventArgs) Handles Me.Load
If Not Page.IsPostBack Then
sCreateTable()
sFillPeriods()
sRefreshData(Format(Now, "yyyyMM"), Format(DateAdd(DateInterval.Year, -1, Now), "yyyyMM"))
End If
End Sub
Private Sub sFillPeriods()
Dim conMain As New SqlConnection(sGetConnectionString)
Dim comMain As SqlCommand
Dim drMain As SqlDataReader
Dim strSQL As String = "SELECT DISTINCT Period FROM [SR_SalesOverviewCompany] Order by Period DESC"
conMain.Open()
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
Me.cmbPeriods.Items.Clear()
Me.cmbPeriods.Items.Add("Current Period")
Me.cmbPeriods.Items.Add("Year To Date")
If drMain.HasRows Then
While drMain.Read
If Not IsDBNull(drMain.Item("Period")) Then
Me.cmbPeriods.Items.Add(drMain.Item("Period"))
End If
End While
End If
End Sub
Private Function sGetConnectionString() As String
Dim conString = ConfigurationManager.ConnectionStrings("STOKVIS LIVEConnectionString")
Dim strConnString As String = conString.ConnectionString
Return strConnString
End Function
Protected Sub grdSalesLines_DataBound(sender As Object, e As System.EventArgs) Handles grdSalesLines.DataBound
If Me.cmbPeriods.SelectedItem.Text <> "Current Period" Then
grdSalesLines.Columns(3).Visible = False
grdSalesLines.Columns(4).Visible = False
grdSalesLines.Columns(5).Visible = False
grdSalesLines.Columns(7).Visible = False
Else
grdSalesLines.Columns(3).Visible = True
grdSalesLines.Columns(4).Visible = True
grdSalesLines.Columns(5).Visible = True
grdSalesLines.Columns(7).Visible = True
End If
End Sub
Protected Sub grdSalesLines_RowCommand(sender As Object, e As System.Web.UI.WebControls.GridViewCommandEventArgs) Handles grdSalesLines.RowCommand
Dim intRow As Integer = CInt(e.CommandArgument)
Response.Redirect("SalesDetails.aspx?p=" & Me.cmbPeriods.SelectedItem.Text & "&s=" & grdSalesLines.Rows(intRow).Cells(1).Text)
End Sub
Protected Sub grdSalesLines_RowDataBound(sender As Object, e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles grdSalesLines.RowDataBound
Dim intCounter As Integer
If e.Row.Cells(1).Text = "Total" Then
For intCounter = 0 To e.Row.Cells.Count - 1
With e.Row.Cells(intCounter)
.ForeColor = Drawing.Color.White
.BackColor = Drawing.Color.DarkBlue
.Font.Bold = True
End With
Next
End If
End Sub
Private Sub sCreateTable()
tblData.Columns.Clear()
tblData.Columns.Add(New Data.DataColumn("Code", System.Type.GetType("System.String")))
tblData.Columns.Add(New Data.DataColumn("Salesperson", System.Type.GetType("System.String")))
tblData.Columns.Add(New Data.DataColumn("OpenOrders", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("OpenOrdersCurrentPeriod", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("ShippedNotInvoiced", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("Sales", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("Projected", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("Budget", System.Type.GetType("System.Double")))
tblData.Columns.Add(New Data.DataColumn("PreviousYear", System.Type.GetType("System.Double")))
End Sub
Protected Sub btnRefresh_Click(sender As Object, e As System.EventArgs) Handles btnRefresh.Click
If Me.cmbPeriods.SelectedItem.Text = "Current Period" Then
sRefreshData(Format(Now, "yyyyMM"), Format(DateAdd(DateInterval.Year, -1, Now), "yyyyMM"))
Else
sRefreshData(Me.cmbPeriods.SelectedItem.Text, "")
End If
End Sub
Protected Sub btnExcel_Click(sender As Object, e As System.EventArgs) Handles btnExport.Click
sExportGrid()
End Sub
Protected Sub cmbPeriods_SelectedIndexChanged(sender As Object, e As System.EventArgs) Handles cmbPeriods.SelectedIndexChanged
sCreateTable()
If Me.cmbPeriods.SelectedItem.Text = "Current Period" Then
sRefreshData(Format(Now, "yyyyMM"), Format(DateAdd(DateInterval.Year, -1, Now), "yyyyMM"))
Else
sRefreshData(Me.cmbPeriods.SelectedItem.Text, "")
End If
End Sub
Private Sub sRefreshData(pPeriod As String, pPreviousYearPeriod As String)
Dim conMain As New SqlConnection(sGetConnectionString)
Dim comMain As SqlCommand
Dim drMain As SqlDataReader
Dim dtRow As Data.DataRow
Dim strSQL As String
Dim intTeller As Integer
Dim blnYearToDate As Boolean = False
sCreateTable()
If pPeriod = "Year To Date" Then
pPeriod = ""
blnYearToDate = True
End If
strSQL = "SELECT code, Name from SR_SalesPerson"
conMain.Open()
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
dtRow = tblData.NewRow()
dtRow.Item("Code") = drMain.Item("Code")
dtRow.Item("SalesPerson") = drMain.Item("Name")
dtRow.Item("OpenOrders") = 0
dtRow.Item("OpenOrdersCurrentPeriod") = 0
dtRow.Item("ShippedNotInvoiced") = 0
dtRow.Item("Sales") = 0
dtRow.Item("Projected") = 0
dtRow.Item("Budget") = 0
dtRow.Item("PreviousYear") = 0
tblData.Rows.Add(dtRow)
End While
dtRow = tblData.NewRow()
dtRow.Item("Code") = "Total"
dtRow.Item("SalesPerson") = ""
dtRow.Item("OpenOrders") = 0
dtRow.Item("OpenOrdersCurrentPeriod") = 0
dtRow.Item("ShippedNotInvoiced") = 0
dtRow.Item("Sales") = 0
dtRow.Item("Projected") = 0
dtRow.Item("Budget") = 0
dtRow.Item("PreviousYear") = 0
tblData.Rows.Add(dtRow)
End If
drMain.Close()
comMain.Dispose()
strSQL = "SELECT * FROM SR_SalesOpenOrdersShippedNotInvoiced"
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("Code") Then
tblData.Rows(intTeller).Item("ShippedNotInvoiced") = drMain.Item("AmountRest")
End If
Next
End While
End If
drMain.Close()
comMain.Dispose()
strSQL = "SELECT * FROM SR_SalesOpenOrdersPerSalesperson"
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("Code") Then
tblData.Rows(intTeller).Item("OpenOrders") = drMain.Item("OpenOrders")
End If
Next
End While
End If
drMain.Close()
comMain.Dispose()
strSQL = "SELECT * FROM SR_SalesOpenOrdersPerSalesPersonPerPeriod WHERE Period='" & pPeriod & "'"
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("SalesPerson Code") Then
tblData.Rows(intTeller).Item("OpenOrdersCurrentPeriod") = drMain.Item("AmountRest")
End If
Next
End While
End If
drMain.Close()
comMain.Dispose()
strSQL = "SELECT * FROM SR_BudgetPerSalesPersonPerPeriod WHERE strPeriod='" & pPeriod & "'"
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("strCode") Then
tblData.Rows(intTeller).Item("Budget") = drMain.Item("dblSales")
End If
Next
End While
End If
drMain.Close()
comMain.Dispose()
strSQL = "SELECT * FROM SR_HistSalesPerSalesPersonPerPeriod WHERE strPeriod='" & pPreviousYearPeriod & "'"
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("strCode") Then
tblData.Rows(intTeller).Item("PreviousYear") = drMain.Item("dblSales")
End If
Next
End While
End If
drMain.Close()
comMain.Dispose()
If blnYearToDate Then
strSQL = "SELECT Salesperson, SUM(Sales) AS Sales, SUM([Cost of Sales]) AS [Cost of Sales], SUM(Margin) AS Margin, SUM(Margin) / SUM(Sales) AS SalesPercent, Code " & _
"FROM dbo.SR_SalesPerSalesperson " & _
"WHERE (Period LIKE '" & Now.Year & "%') " & _
"GROUP BY Salesperson, Code"
Else
strSQL = "SELECT * FROM SR_SalesPerSalesperson WHERE Period='" & pPeriod & "'"
End If
comMain = New SqlCommand(strSQL, conMain)
drMain = comMain.ExecuteReader
If drMain.HasRows Then
While drMain.Read
For intTeller = 0 To tblData.Rows.Count - 1
If tblData.Rows(intTeller).Item("Code") = drMain.Item("Code") Then
tblData.Rows(intTeller).Item("Sales") = drMain.Item("Sales")
End If
Next
End While
End If
For intTeller = 0 To tblData.Rows.Count - 1
With tblData.Rows(intTeller)
.Item("Projected") = .Item("Sales") + .Item("ShippedNotInvoiced") + .Item("OpenOrdersCurrentPeriod")
End With
Next
Dim intLastRow As Integer = tblData.Rows.Count - 1
For intTeller = 0 To tblData.Rows.Count - 2
With tblData.Rows(intTeller)
tblData.Rows(intLastRow).Item("Sales") += fCheckValue(.Item("Sales"))
tblData.Rows(intLastRow).Item("OpenOrders") += fCheckValue(.Item("OpenOrders"))
tblData.Rows(intLastRow).Item("OpenOrdersCurrentPeriod") += fCheckValue(.Item("OpenOrdersCurrentPeriod"))
tblData.Rows(intLastRow).Item("ShippedNotInvoiced") += fCheckValue(.Item("ShippedNotInvoiced"))
tblData.Rows(intLastRow).Item("Projected") += fCheckValue(.Item("Projected"))
tblData.Rows(intLastRow).Item("Budget") += fCheckValue(.Item("Budget"))
tblData.Rows(intLastRow).Item("PreviousYear") += fCheckValue(.Item("PreviousYear"))
End With
Next
Me.grdSalesLines.DataSource = tblData
Me.grdSalesLines.DataBind()
Try
drMain.Close()
comMain.Dispose()
conMain.Close()
Catch ex As Exception
End Try
End Sub
Private Function fCheckValue(pField As Object) As Double
Dim dblValue As Double = 0
If IsDBNull(pField) Then
dblValue = 0
Else
dblValue = CDbl(pField)
End If
Return dblValue
End Function
End Class
First, it might be useful to have a helper function such as the following:
Private Function GetNullableValue(Of T)(ByVal dataRow As DataRow, ByVal columnName As String, ByVal defaultIfNull As T) As T
If Not IsDBNull(dataRow.Item(columnName)) Then
Return CType(dataRow.Item(columnName), T)
End If
Return CType(defaultIfNull, T)
End Function
To check for DBNull, you could then modify your code as follows:
For intTeller = 0 To tblData.Rows.Count - 1
Dim row As DataRow = tblData.Rows(intTeller)
With row
.Item("Projected") = GetNullableValue(row, "Sales", 0) + GetNullableValue(row, "ShippedNotInvoiced", 0) + GetNullableValue(row, "OpenOrdersCurrentPeriod", 0)
End With
Next
NOTE: The above should side-step the exception. However, the fact that one of these columns is null may be indicative of another problem - e.g. perhaps there are problems with the query or the data
I have two CheckboxLists. Based on the items checked, the checked values are concatenated into a comma separated string and passed to my entity framework method. The result would be a List(Of Entity).
I want to convert
SELECT *
FROM dbo.Findings /*Below criteria is added only if any of the values are checked*/
WHERE FindingCategoryId IN (<Checked Values>)
AND FindingSeverityId IN (<CheckBoxValues>)
I am unable to find an equivalent for IN for VB.Net in EF.
I looked at the C# post here and came up with the below code. I get an error as
Unable to create a constant value of type 'System.Object'. Only primitive types ('such as Int32, String, and Guid') are supported in this context.
How can I use the IN clause in Vb.Net? Any help is appreciated.
My code:
Public Function Findings(ByVal findingSeverity As String, ByVal findingCategory As String) As List(Of Finding)
Dim aTypeLoanId As Integer = If(Not IsNothing(AuditTypeLoanId), AuditTypeLoanId, -1)
Dim findingTargetId = CInt(FindingTarget.LoanHeader)
Using e As New LQCEntities()
Dim result = (From f In e.FindingEntities _
From hmd In e.HeaderMetaDataEntities.Where(Function(h) h.MetaDataId = f.TargetId).DefaultIfEmpty() _
From cl In e.CheckListEntities.Where(Function(c) c.CheckListId = f.TargetId).DefaultIfEmpty() _
Where f.AuditTypeLoanId = aTypeLoanId _
Select New Finding With _
{
.FindingId = f.FindingId, _
.FindingCategoryId = f.FindingCategoryId, _
.FindingSeverityId = f.FindingSeverityId, _
.EnteredBy = f.ADUser.DisplayName, _
.EnteredDate = f.EnteredDate _
})
Dim fsArray() = Nothing
Dim fcArray() = Nothing
If (Not String.IsNullOrEmpty(findingSeverity)) Then
Dim fs = findingSeverity.Split(",")
For i As Integer = 0 To fs.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fs(i), j)) Then
ReDim Preserve fsArray(i)
fsArray(i) = j
End If
Next
If (fsArray.Count > 0) Then
result = result.Where(Function(i) fsArray.Contains(i.FindingSeverityId))
End If
End If
If (Not String.IsNullOrEmpty(findingCategory)) Then
Dim fc = findingCategory.Split(",")
For i As Integer = 0 To fc.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fc(i), j)) Then
ReDim Preserve fcArray(i)
fcArray(i) = j
End If
Next
If (fcArray.Count > 0) Then
result = result.Where(Function(i) fcArray.Contains(i.FindingCategoryId))
End If
End If
Return result.ToList()
End Using
End Function
I changed the fsArray and fcArray to a List(Of Integer) and it worked.
Code is as below:
Public Function Findings(ByVal findingSeverity As String, ByVal findingCategory As String) As List(Of Finding)
Dim aTypeLoanId As Integer = If(Not IsNothing(AuditTypeLoanId), AuditTypeLoanId, -1)
Dim findingTargetId = CInt(FindingTarget.LoanHeader)
Using e As New LQCEntities()
Dim result = (From f In e.FindingEntities _
From hmd In e.HeaderMetaDataEntities.Where(Function(h) h.MetaDataId = f.TargetId).DefaultIfEmpty() _
From cl In e.CheckListEntities.Where(Function(c) c.CheckListId = f.TargetId).DefaultIfEmpty() _
Where f.AuditTypeLoanId = aTypeLoanId _
Select New Finding With _
{
.FindingId = f.FindingId, _
.AuditTypeLoanId = f.AuditTypeLoanId, _
.FindingCategoryId = f.FindingCategoryId, _
.CategoryDescription = f.FindingCategory.CategoryDescription, _
.FindingSeverityId = f.FindingSeverityId, _
.SeverityDescription = f.FindingSeverity.SeverityDescription, _
.TargetId = f.TargetId, _
.UserResponse = f.UserResponse, _
.Field = If(f.FindingTargetId = findingTargetId, hmd.ColumnDescription, cl.CheckListDesc), _
.OldValue = f.OldValue, _
.NewValue = f.NewValue, _
.Comments = f.Comments, _
.EnteredBy = f.ADUser.DisplayName, _
.EnteredDate = f.EnteredDate _
})
If (Not String.IsNullOrEmpty(findingSeverity)) Then
Dim fsList As New List(Of Integer)
Dim fs = findingSeverity.Split(",")
For i As Integer = 0 To fs.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fs(i), j)) Then
fsList.Add(j)
End If
Next
If (fsList.Count > 0) Then
result = result.Where(Function(i) fsList.Contains(i.FindingSeverityId))
End If
End If
If (Not String.IsNullOrEmpty(findingCategory)) Then
Dim fc = findingCategory.Split(",")
Dim fcList As New List(Of Integer)
For i As Integer = 0 To fc.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fc(i), j)) Then
fcList.Add(j)
End If
Next
If (fcList.Count > 0) Then
result = result.Where(Function(i) fcList.Contains(i.FindingCategoryId))
End If
End If
Return result.ToList()
End Using
End Function
I have the following VB Code which is inserting record in TRACK table. Also in the same time I am doing insert/update/delete in this tables CONTENT, COMNMENTRECORDED, NOTESASFILE, MASTER NOTIFICATION, DETAIL NOTIFICATION.
Dim Obj_trans As SqlTransaction = Nothing
Dim cmd As New SqlCommand()
If objcOnn.Initialize_cOnnection = True Then
cmd.Connection = objcOnn.cOnn
Obj_trans = objcOnn.cOnn.BeginTransaction
cmd.Transaction = Obj_trans
If ForwadContent(intBasketID, 0, .SubItems(3).Text, str, _ intBasketID, .SubItems(2).Text, .SubItems(4).Text, "Forward", Forward, Now.TimeOfDay.ToString, _ strComments, ContentState, Ascuflag, cmd, strAttachedFile) = True Then
dset_bsktUser = obj_notification.GetBasketUser(Forward, cmd)
If Not dset_bsktUser Is Nothing Then
'Update the DetailNotification
Dim SelUserid As String
SelUserid = LoginUserID ' oLogin.ReadFromLogFile("UID")
'what happen if forwarded by Administrator ?
If obj_notification.UpdateDetNotification(3, CInt(lvView.Items(iSelected).SubItems(3).Text), CInt(SelUserid), 3, cmd) = True Then
'Insert Into Master notification
Dim id As Integer
id = obj_notification.InsertMasterNotification(Forward, destibsktname, CInt(lvView.Items(iSelected).SubItems(3).Text), DocSNo, indexcardid, cmd)
'now Insert the record into DetailNotification
For i = 0 To dset_bsktUser.Tables(0).Rows.Count - 1
Dim userid As Integer
userid = CInt(dset_bsktUser.Tables(0).Rows(i).Item(0))
obj_notification.InsertDetailNotification(id, CInt(userid), 0, 0, cmd)
Next
End If
End If
Else
TransRolloback(Obj_trans)
End If
End With
End If
lvView.Items.RemoveAt(iSelected)
End If 'End Connection
Obj_trans.Commit()
objcOnn.dispOse_cOnn()
Public Function CreateDocumentTrack(ByVal Sender As Integer, ByVal IndexCard As String, ByVal DocumentNo As Integer, ByVal Status As String, B
> Blockquote
yVal SentTo As Integer, ByVal SentTime As String, ByRef cmd As SqlCommand, ByVal lstview As ListView, ByVal listFiles As ListView) As Boolean
Dim Ds_Track As New DataSet()
Dim Da As New SqlDataAdapter()
Dim TrackID As Integer = 0
Try
If oTableInfo.Exists(TBL_TRACK, SP_CREATE_TRACK_TABLE) = False Then Exit Function
cmd.CommandText = "Insert into TRACK (SENDER,INDEXCARDNAME,DOCUMENTnO,STATUS,SENTTO,SENTDATE,SENTTIME,nOTEid,uSERid) VALUES(#SENDER,#INDEXCARDNAME,#sTATUS,#sENTTO,#sENTdATE,#sENTtIME,#nOTEid,#uSERid)
With cmd.Parameters
.Add("#sENDER, SQLDBTYPE.INT,9, "SENDER").Value = Sender
.Add("#iNDEXCARDnAME", SQLDBTYPE.NVARCHAR,75,"iNDEXCARDNAME").Value = IndexCard
.Add("#dOCUMENTnO",SQLDBTYPE.INT,9, "dOCUMENTnO").Value = DocumentNo
.Add("#sTATUS", SQLDBTYPE.NVARCHAR,25, "STATUS".Value = Status
.Add("#sENTTO", SQLDBTYPE.INT,9, "SENTTO").Value = SentTo
End With
cmd.ExecuteNonQuery()
cmd.Parameters.Clear()
'Get Inserted ID of Track
TrackID = CInt(Ds_Track.Tables(0).Rows(0).Item(0))
'cmd.Dispose()
cmd.Parameters.Clear()
'Insert into Notes corrsponcding with inserted trckid
'INSERT INTO CommentRecorded (TID, RID, TrackTag, BasketID, ContentID, UserName, ComDt, DocumentSno, IndexCardName, SourceTab) VALUES (,,,,,,,,,)
cmd.CommandText = "INSERT INTO CommentRecorded (TID, RID, TrackTag, BasketID, ContentID, UserName, ComDt, DocumentSno, IndexCardName, SourceTab) VALUES (#TID, #RID, #TrackTag, #BasketID, #ContentID, #UserName, getDate(), #DocumentSno, #IndexCardName, #SourceTab)"
With cmd.Parameters
.Add("#TID", SqlDbType.Int) ' .Value = TrackID
.Add("#RID", SqlDbType.Int)
.Add("#TrackTag", SqlDbType.NVarChar, 100)
.Add("#BasketID", SqlDbType.Int)
.Add("#ContentID", SqlDbType.Int)
.Add("#UserName", SqlDbType.NVarChar, 75)
' .Add("#ComDt", SqlDbType.DateTime)
.Add("#DocumentSno", SqlDbType.Int)
.Add("#IndexCardName", SqlDbType.NVarChar)
.Add("#SourceTab", SqlDbType.NVarChar)
End With
Dim sValues() As String
Dim i, j As Integer
For i = 0 To lstview.Length - 1
If Not lstview(i) Is Nothing Then
If Not lstview(i) = "" Then
sValues = Split(lstview(i), "ç")
With cmd.Parameters
.Item("#TID").Value = TrackID
.Item("#RID").Value = sValues(8)
.Item("#TrackTag").Value = sValues(1)
.Item("#BasketID").Value = sValues(9)
.Item("#ContentID").Value = System.DBNull.Value ' sValues(8)
.Item("#UserName").Value = sValues(4)
'.Item("#ComDt").Value = Format(Now.Date, "dd-MMM-yyyy")
.Item("#DocumentSno").Value = sValues(11)
.Item("#IndexCardName").Value = sValues(12)
.Item("#SourceTab").Value = sValues(13)
End With
cmd.ExecuteNonQuery()
End If
End If
Next
cmd.Parameters.Clear()
'INSERT INTO NotesAsFile (TID, AFID, TrackTag, BasketID, ContentID, UserName, ComDt, DocumentSno, IndexCardName) VALUES (,,,,,,,,)
cmd.CommandText = "INSERT INTO NotesAsFile (TID, AFID, TrackTag, BasketID, ContentID, UserName, ComDt, DocumentSno, IndexCardName) VALUES (#TID, #AFID, #TrackTag, #BasketID, #ContentID, #UserName, GetDate(), #DocumentSno, #IndexCardName)"
With cmd.Parameters
.Add("#TID", SqlDbType.Int) ' .Value = TrackID
.Add("#AFID", SqlDbType.Int)
.Add("#TrackTag", SqlDbType.NVarChar, 100)
.Add("#BasketID", SqlDbType.Int)
.Add("#ContentID", SqlDbType.Int)
.Add("#UserName", SqlDbType.NVarChar, 75)
'.Add("#ComDt", SqlDbType.DateTime)
.Add("#DocumentSno", SqlDbType.Int)
.Add("#IndexCardName", SqlDbType.NVarChar)
End With
For i = 0 To listFiles.Length - 1
If Not listFiles(i) Is Nothing Then
If Not listFiles(i) = "" Then
sValues = Split(listFiles(i), "ç")
If sValues(0) <> "" Then
With cmd.Parameters
.Item("#TID").Value = TrackID
.Item("#AFID").Value = sValues(2)
.Item("#TrackTag").Value = "" ' sValues(1)
.Item("#BasketID").Value = sValues(4)
.Item("#ContentID").Value = System.DBNull.Value ' sValues(8)
.Item("#UserName").Value = sValues(6)
'.Item("#ComDt").Value = Format(Now.Date, "dd-MMM-yyyy")
.Item("#DocumentSno").Value = sValues(7)
.Item("#IndexCardName").Value = sValues(8)
End With
cmd.ExecuteNonQuery()
End If
End If
End If
Next
cmd.Parameters.Clear()
CreateDocumentTrack = True
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Information, "Rosetta")
'oConn.DisposeConnection()
'oMessage.DisplayException(ex.ToString)
CreateDocumentTrack = False
Finally
Ds_Track.Dispose()
Ds_Track = Nothing
Da.Dispose()
Da = Nothing
End Try
End Function
Public Function CheckDocumentTrack(ByVal SentTo As Integer, ByVal DocumentNo As Integer, ByVal IndexCard As String, ByRef ContentState As Integer, ByRef cmd As SqlCommand) As Boolean
Dim dset As New DataSet()
Dim adp As New SqlDataAdapter()
Dim count As Integer = 0
Try
If oTableInfo.Exists(TBL_TRACK, SP_CREATE_TRACK_TABLE) = False Then Exit Function
'Check that this already come from the basket or not
cmd.CommandText ="Select Count(SENTTO) FROM TRACK" where SENTTO=#SENTTO AND DOCUMENTNO=#DOCUMENTNO AND INDEXCARDNAME=#INDEXCARDNAME
With cmd.Parameters
.Add("#SeNTTO", SqlDbType.Int, 9, "sENTTO").Value = SentTo
.Add"#dOCUMENTnO",SqlDbType.Int, 9, "dOCUMENTnO").Value = DocumentNo
.Add("#iNDEXCARDNAME",SqlDbType.NVARCHAR, 75,"iNDEXCARDnAME").Value = IndexCard
End With
adp.SelectCommand = cmd
adp.Fill(dset, "tRACK")
count = dset.Tables(0).Rows(0).Item(0)
If count > 0 Then
ContentState = 4
Else
ContentState = 1
End If
cmd.ExecuteScalar()
cmd.Parameters.Clear()
Return True
Catch ex As Exception
oMessage.DisplayException(ex.ToString)
Return False
Finally
cmd.Parameters.Clear()
dset.Dispose()
dset = Nothing
adp.Dispose()
adp = Nothing
End Try
Friend Function UpdateContent(ByVal approved As Integer, ByVal BasketID As Integer, ByRef cmd As SqlCommand, ByVal ContentID As String, ByVal Description As String, ByVal asu_Rec_flag As Integer, ByVal sender As Integer) As Boolean
Try
If oTableInfo.Exists(TBL_CONTENT, SP_CREATE_CONTENT_TABLE) = False Then Exit Function
cmd.CommandText = "Update CONTENT Set BASKETID=#BASKETID, Description=#Description,Approved=#Approved,AssuReceivingFlag=#AsuReceivingFlag,FbkDate=getdate(),Sender=#Sender where ContentID=#ContentID
With cmd.Parameters
.Add("#BASKETID",SqlDbType.Int, 9, BasketID).Value = BasketID
.Add("#Approved",SqlDbType.Int, 9, aPPROVED).Value = approved
.Add"#ContentID", SqlDbType.Int, 9, CONTENTID).Value = ContentID
.Add("#Description", SqlDbType.nvarchar, 500, dESCRIPTION).Value = Server_Time_Content() & Description
.Add("#AsuReceivingFlag", SqlDbType.Int, 9, AsuReceivingFlag).Value = asu_Rec_flag
.Add("#Sender", SqlDbType.Int, 9).Value = sender
End With
cmd.ExecuteNonQuery()
cmd.Parameters.Clear()
UpdateContent = True
Catch ex As Exception
oMessage.DisplayException(ex.ToString)
UpdateContent = False
Finally
cmd.Parameters.Clear()
End Try
End Function
Private Function ForwadContent( _
ByVal BskID As Integer, _
ByVal approved As Integer, _
ByVal ContentID As String, _
ByVal description As String, _
ByVal Sender As Integer, _
ByVal indexCardName As String, _
ByVal documentNo As Integer, _
ByVal Status As String, _
ByVal SentTo As Integer, _
ByVal SentTime As String, _
ByRef NoteID() As String, _
ByVal ContentState As Integer, _
ByVal ASU_Rec_FLAG As Integer, _
ByVal cmd As SqlCommand, _
ByRef listFiles() As String) As Boolean
Try
Dim Obj_trans As SqlTransaction
If oTrack.CheckDocumentTrack(SentTo, documentNo, indexCardName, ContentState, cmd) = True Then
approved = ContentState
'If oContent.UpdateContent(SentTo, approved, cmd, ContentID, description) = True Then
If Status = "Approved" Or Status = "Reject" Then
If oContent.DeleteContent(ContentID, cmd) = True Then
Else
TransRolloback(Obj_trans)
End If ' end if delete content
Else
If oContent.UpdateContent(SentTo, approved, cmd, ContentID, description, ASU_Rec_FLAG, Sender) = True Then
Else
Try
Obj_trans.Rollback()
ForwadContent = False
Catch
MsgBox(Err.Description, MsgBoxStyle.Information, "Rosetta")
End Try
Obj_trans = Nothing
Exit Function
End If 'End if update content
End If 'end if Approved/Reject
If oTrack.CreateDocumentTrack(Sender, indexCardName, documentNo, Status, SentTo, SentTime, cmd, NoteID, listFiles, LoginUserName) = True Then
ForwadContent = True
Else
Try
Obj_trans.Rollback()
ForwadContent = False
Catch
MsgBox(Err.Description, MsgBoxStyle.Information, "Rosetta")
End Try
Obj_trans = Nothing
Exit Function
End If
Else
Try
Obj_trans.Rollback()
ForwadContent = False
Catch
MsgBox(Err.Description, MsgBoxStyle.Information, "Rosetta")
End Try
Obj_trans = Nothing
Exit Function
End If
END IF
Catch
MsgBox(Err.Description)
End Try
END FUNCTION
When I retrieve a record from TRACK table,
SELECT * FROM TRACK WHERE DOCUMENTNO=12 AND INDEXCARDNAME='ASD' ORDER BY TrackID
I will get this error sometimes(DEAD LOCK occurred ON TRACK),
66-transaction-process-id-was-deadlocked-on-resources-with-another-process-and-has-been-chosen-as-the-deadlock-victim-rerun-the-transaction
ALL ABOVE TABLES HAVE NON-CLUSTERD ON AUTO GENERATED ID'S
The quickest way to try and get around this would be to change this:
SELECT * FROM TRACK WHERE DOCUMENTNO=12 AND INDEXCARDNAME='ASD' ORDER BY TrackID
to
SELECT * FROM TRACK (NOLOCK) WHERE DOCUMENTNO=12 AND INDEXCARDNAME='ASD' ORDER BY TrackID
There are downsides to this:
http://www.sqlservercentral.com/Forums/Topic177803-8-1.aspx
However, for the most part situations they will not come into play. This is a remedy for the problem rather than solving the underlying problem, without knowing what calls are made to your database and more about your data access in general that is going to be very difficult to do.