I am facing a critical problem. I have developed an ERP for a manufacturing company and it has all the dept. linked. If users tries to work simultaneously on the same data entry screen, their records get messed up with each other.
e.g. while saving a voucher for the same bank, their accounting details mess up and the voucher data is overwritten. Somehow the program is not able to generate different voucher nos. at the time of saving. it gets same voucher no. for all entries.
I am using ADO 2.0. Software is developed in vb6.0 and sql server 2000. The recordset is opened with adOpenDynamic and adLockOptimistic flags.
every user logs in with sa and pwd (sql authentication).
example details of voucher .
--------------------------
purchase voucher (bill).
==================
Two tables 1. pvheader 2. pvdetail (joined by ipvno and iyrsrno) ipvno is voucher no, iyrsrno is year serial no. So it is compound key.
Here is the code
Also the record class attached which is a wrapper for the adodb.recordset object.
# Public Sub SaveRecord()
# On Error GoTo ErrorHandler
#
# With frmVoPurchase
#
# If Not VerifiedFields Then Exit Sub
#
# Dim recnew As New Record
#
# If ValidateAmount = False Then
# DisplayMsg "Check Bill Amount !", gsMTitle, msgbsOK, msgisCritical: Exit Sub
# End If
#
# If ChkBillDebitAmt = False Then
# DisplayMsg "Bill Amt And debited amt are mismatching ! ", gsMTitle, msgbsOK, msgisCritical: Exit Sub
# End If
#
# If Val(.txtName(11)) > 0 And .txtName(10) = "" Then
# DisplayMsg "Enter Sales tax !", gsMTitle, msgbsOK, msgisCritical: Exit Sub
# End If
#
# If Val(.txtName(20)) > 0 And .chkTDS.Value = vbUnchecked And sChkTdsFlag = False Then
# If MsgBox("Check tds flag ! Do you want to save record..", vbYesNo, gsMTitle) = vbYes Then
# Else
# Exit Sub
# End If
# End If
#
# recnew.Create "PurchaseVo"
# If Not gbTransBegined Then gconGM.BeginTrans
# gbTransBegined = True
#
# If msSaveMode = "Add" Then
#
# GenerateNewCode
#
# recnew.NewRecord
# recnew.Records!iYrSrNo = giYrSrNo
# recnew.FillDBO frmVoPurchase, 48, .mdbfVoPurchase
# Save1
# If .lstGrn.ListCount > 1 Then
# Save2
# End If
# If .chkModvat.Value = vbChecked Then
# 'gconGM.Execute "EXEC GenerateModvatVo " & "'" & Format(.txtName(4), "MM/DD/YYYY") & "'" & "," & .txtName(38) & "," & "'" & msModvatType & "'" & "," & "'" & .flxAcDetail.GetData(1, 0) & "'"
# End If
# SaveTDS
# ElseIf msSaveMode = "Edit" Then
# gconGM.Execute "DELETE FROM PurchaseVo WHERE vPVRNo=" & "'" & msPVNo & "'" & " AND iYrSrNo=" & giYrSrNo
# recnew.NewRecord
# recnew.FillDBO frmVoPurchase, 48, .mdbfVoPurchase
# recnew.Records!iYrSrNo = giYrSrNo
# gconGM.Execute "DELETE FROM PurchaseVoDet WHERE vPVRNo=" & msPVNo & " AND iYrSrNo=" & giYrSrNo
# gconGM.Execute "DELETE FROM PVGRNDet WHERE vPVRNo=" & msPVNo & " AND iYrSrNo=" & giYrSrNo
# Save1
# Save2
# SaveTDS
# End If
# recnew.Records!isbtid = Val(.lblSBTID)
# recnew.Records!iImport = Val(.chkImp.Value)
# recnew.Records!iFAsset = Val(.chkFAsset.Value)
# recnew.Records!iOther = Val(.chkOther.Value)
# recnew.Records!fDuty50 = Val(.txtName(58))
# recnew.Save
# recnew.Destroy
#
# gbTransBegined = False
# gconGM.CommitTrans
#
# If msSaveMode = "Add" Then
# DisplayMsg "Vouchar No: " & msPVNo & " Generated", gsMTitle, msgbsOK, msgisExclaimation
# End If
# Set recnew = Nothing
#
# .chkF31.Value = vbUnchecked
# .chkF31.Enabled = False
#
#
# If NotMatching Then
# DisplayMsg "Enter was not saved correctly !", gsMTitle, msgbsOK, msgisExclaimation
# Exit Sub
# End If
#
#
# ClearScreen
# End With
#
# Exit Sub
# ErrorHandler:
# ShowError "SaveRecord"
# End Sub
#
#
#
#
# Public Sub Save1()
# On Error GoTo ErrorHandler
#
# Dim recVoPurchase As New Record
# Dim a As Integer
#
# With frmVoPurchase
# recVoPurchase.Create "PurchaseVoDet"
# For a = 1 To .lvwAcc.ListItems.Count
# recVoPurchase.NewRecord
# recVoPurchase.Records!iYrSrNo = giYrSrNo
# recVoPurchase.Records!vPVRNo = msPVNo
# recVoPurchase.Records!vAccCode = Trim(.lvwAcc.ListItems(a).Text) 'Account Code
# recVoPurchase.Records!vAccName = Trim(.lvwAcc.ListItems(a).SubItems(1)) 'Account Name
# recVoPurchase.Records!fAmt = .lvwAcc.ListItems(a).SubItems(2) 'Amount
# Next a
#
# recVoPurchase.Save
# recVoPurchase.Destroy
# End With
# Set recVoPurchase = Nothing
#
# Exit Sub
# ErrorHandler:
# ShowError "Save1"
# End Sub
#
#
#
#
# Private Function VerifiedFields() As Boolean
# On Error GoTo ErrorHandler
#
# VerifiedFields = True
#
# With frmVoPurchase
# Dim vbTemp As New CVerifyBin
#
# If .chkLbr = vbChecked Then
# vIndexes = Array(0, 1, 4, 6, 22, 24, 26)
# vbTemp.AddToBin .txtName(6), vtDate, .txtName(6), "", ""
#
# vbTemp.AddToBin .txtName(22), vtDouble, .txtName(22), "", ""
# vbTemp.AddToBin .txtName(24), vtString, .txtName(24), "", ""
# vbTemp.AddToBin .txtName(26), vtDouble, .txtName(26), "", ""
# vbTemp.AddToBin .txtName(6), vtDouble, .txtName(6), "", ""
# vbTemp.AddToBin .txtName(4), vtDouble, .txtName(4), "", ""
# vbTemp.AddToBin .txtName(3), vtString, .txtName(3), "", ""
# End If
# vbTemp.AddToBin .txtName(0), vtString, .txtName(0), "", ""
# vbTemp.AddToBin .txtName(1), vtString, .txtName(1), "", ""
# vbTemp.AddToBin .txtName(4), vtDate, .txtName(4), "", ""
# vbTemp.AddToBin .txtName(3), vtString, .txtName(3), "", ""
# vbTemp.AddToBin .txtName(6), vtDouble, .txtName(6), "", ""
#
# If .chkLbr.Value = vbUnchecked Then
# ' vbTemp.AddToBin .txtName(11), vtDouble, .txtName(11), "", ""
# End If
#
# If Not vbTemp.VerifyAndShowValues Then
# VerifiedFields = False
# vbTemp.ClearBin
# Set vbTemp = Nothing
# Exit Function
# End If
#
# vbTemp.ClearBin
#
# Set vbTemp = Nothing
#
# If msSaveMode = "Add" Then
# If Not .txtName(7) = "" Or .txtName(7) = "00/00/0000" Then
# If DateDiff("D", .txtName(6), .txtName(4)) >= 0 And DateDiff("D", .txtName(7), .txtName(4)) >= 0 Then
# Else
# DisplayMsg "PV date should be greater than GRN date and Bill date", gsMTitle, msgbsOK, msgisCritical
# VerifiedFields = False
# Exit Function
# End If
# End If
# End If
# End With
#
# Exit Function
# ErrorHandler:
# ShowError "VerifiedFields"
# End Function
#
#
#
#
# Private Sub GenerateNewCode()
# On Error GoTo ErrorHandler
#
# Dim recVoPurchase As New Record
#
# recVoPurchase.ExecuteQuery "SELECT MAX(CAST(vPVRNo AS Integer)) AS Code FROM PurchaseVo WHERE iYrSrNo=" & giYrSrNo
# recVoPurchase.Refresh
#
# If Not IsNull(recVoPurchase.Records!Code) Then
# msPVNo = InsChars(4 - Len(CStr(Val(recVoPurchase.Records!Code) + 1)), "0") & (Val(recVoPurchase.Records!Code) + 1)
# frmVoPurchase.txtName(0) = msPVNo
# Else
# msPVNo = ReturnQueryValue("SELECT vDocNo FROM DocSerials WHERE vDocType='PURVO' AND iYrSrNo=" & giYrSrNo)
# 'Dim recnew As New Record
# 'recnew.ExecuteQuery "SELECT vValue FROM AllParams WHERE vDept='ACCOUNTS' AND vName='PURVO'"
# 'If recnew.RecordCount > 0 Then
# ' msPVNo = recnew.Records!vValue
# 'End If
# 'recnew.Destroy
# 'Set recnew = Nothing
# frmVoPurchase.txtName(0) = msPVNo
# End If
#
# recVoPurchase.Destroy
# Set recVoPurchase = Nothing
#
# Exit Sub
# ErrorHandler:
# ShowError "GenerateNewCode", "VoPurchase"
# End Sub
Reply With Quote