Option Explicit
Private Sub cmdSave_Click()
Dim RecordsAffected As Long
On Error GoTo ErrorHandler:
' If rst.State = 1 Then rst.Close
' rst.Open "select * from Equipment where EqpName='" & Replace(Trim(txtEquipName.Text), "'", "''") & "'", cnnNew, adOpenStatic, adLockReadOnly, adCmdText
' If rst.RecordCount >= 1 Then
' MsgBox "Equipment Name Already Exists !", vbCritical, "* Duplicate Entry Not Allowed *"
' txtEquipName.SetFocus
' rst.Close
' Exit Sub
' Else
' rst.Close
strSQL = "insert into Equipment(EqpName,Area,Plant,EffOnPlnt,Comments,EisDur,DOffDur,ShtType) Values('" & Replace(Trim(txtEquipName.Text), "'", "''") & "','" & Replace(Trim(txtArea.Text), "'", "''") & "','" & Replace(Trim(txtPlant.Text), "'", "''") & "','" & Replace(Trim(txtEffOnPlantCapacity.Text), "'", "''") & "','" & Replace(Trim(txtComments.Text), "'", "''") & "'," & Trim(txtEisDur.Text) & "," & Trim(txtDoffStr.Text) & ",'" & ShtType & "')"
Debug.Print strSQL
cnnNew.Execute strSQL, RecordsAffected
If RecordsAffected = 0 Then ' Record exist or some other error!!!!!
MsgBox "Equipment Name Already Exists !", vbCritical, "* Duplicate Entry Not Allowed *"
txtEquipName.SetFocus
Exit Sub
End If
If FlgModSubItems = True Then
IncVal = 0
If NOFRows >= 1 Then
For IncVal = 1 To NOFRows
strSQL = "insert into SubItems(EqpNo,EqpName,SubEqpName) values(" & ArrSprItemsa(IncVal) & ",'" & Replace(Trim(txtEquipName.Text), "'", "''") & "','" & Replace(ArrSprItemsb(IncVal), "'", "''") & "')"
Debug.Print strSQL
cnnNew.Execute strSQL
Next
End If
End If
FlgArea = True: FlgComm = True: FlgPlant = True: FlgEff = True
Call ClearFields(Me)
Call LockFields(Me)
Call DisableButtons(Me)
cmdAddNew.Enabled = True
cmdModify.Enabled = True
cmdExit.Enabled = True
cmdAddNew.SetFocus
MsgBox "Record added successfully", vbInformation, "* Record Added *"
ReDim ArrSprItemsa(10) As Variant
ReDim ArrSprItemsb(10) As Variant
FlgNew = False
' End If
If rst.State = 1 Then rst.Close
Set rst = Nothing
ExitRtn:
Exit Sub
ErrorHandler:
ErrorHandler
Resume ExitRtn
End Sub
Private Sub cmdUpdate_Click()
Call UpdateTransactionHere
If FlgModSubItems = True Then
IncVal = 0
strSQL = "delete * from SubItems where EqpName='" & Replace(Trim(cmbEquipName.Text), "'", "''") & "'"
Debug.Print strSQL
cnnNew.Execute strSQL
If NOFRows >= 1 Then
For IncVal = 1 To NOFRows
strSQL = "insert into SubItems(EqpNo,EqpName,SubEqpName) values(" & IIf(IsNull(ArrSprItemsa(IncVal)), Null, ArrSprItemsa(IncVal)) & ",'" & Replace(Trim(cmbEquipName.Text), "'", "''") & "','" & Replace(Trim(ArrSprItemsb(IncVal)), "'", "''") & "')"
Debug.Print strSQL
cnnNew.Execute strSQL
Next
End If
End If
Call ClearFields(Me)
Call LockFields(Me)
Call DisableButtons(Me)
cmdAddNew.Enabled = True
cmdModify.Enabled = True
cmdExit.Enabled = True
cmdSave.Visible = True
cmdUpdate.Visible = False
cmbEquipName.Visible = False
txtEquipName.Visible = True
MsgBox "Record Updated Successfully", vbInformation, "* Record Updated *"
cmdAddNew.SetFocus
FlgMod = False
FlgModSubItems = False
RowsModifiedNow = False
NoRowsNowZero = False
If rsTmp.State = 1 Then rsTmp.Close
Set rsTmp = Nothing
End Sub
Private Sub UpdateTransactionHere()
On Error GoTo ErrorHandler
SQL = "Update Equipment set EqpName='" & Replace(Trim(cmbEquipName.Text), "'", "''") & "',Area='" & Replace(Trim(txtArea.Text), "'", "''") & "',Plant='" & Replace(Trim(txtPlant.Text), "'", "''") & "',EffOnPlnt='" & Replace(Trim(txtEffOnPlantCapacity.Text), "'", "''") & "',Comments='" & Replace(Trim(txtComments.Text), "'", "''") & "',EisDur=" & Trim(txtEisDur.Text) & ",DOffDur=" & Trim(txtDoffStr.Text) & ",ShtType='" & ShtType & "' where ID=" & ModId
Debug.Print SQL
cnnNew.Execute SQL
ExitRtn:
ExitRtn
ErrorHandler:
ErrorHandler
Resume ExitRtn
End Sub
Private Sub cmdDelete_Click()
On Error GoTo ErrorHandler
cmbtxt = Trim(cmbEquipName.Text)
If cmbEquipName.Text = "" Then
MsgBox "Please choose the Equipment Name to Delete", vbCritical, "* Equipment Name Required *"
cmbEquipName.SetFocus
Exit Sub
End If
If rst.State = 1 Then rst.Close
rst.Open "select distinct EqpName from Equipment where EqpName='" & Replace(Trim(cmbEquipName.Text), "'", "''") & "'", cnnNew, adOpenStatic, adLockOptimistic, adCmdText
If rst.RecordCount >= 1 Then
If RsAssg.State = 1 Then RsAssg.Close
RsAssg.Open "select * from NewAssg where EqpName='" & Replace(cmbEquipName.Text, "'", "''") & "'", cnnNew, adOpenKeyset, adLockReadOnly, adCmdText
If RsAssg.RecordCount >= 1 Then
MsgBox cmbEquipName.Text & " " & "Details remains in Assignment Table" & vbCrLf & vbCrLf & " Contact System Administrator", vbCritical, "* Cannot Delete This Equipment *"
If rsTmp.State = 1 Then rsTmp.Close
If RsAssg.State = 1 Then RsAssg.Close
Set rsTmp = Nothing
Set RsAssg = Nothing
Exit Sub
End If
If MsgBox("* Are You sure to delete all Datas for this Equipment *", vbQuestion + vbYesNo, "Delete Equipment") = vbYes Then
strSQL = "Delete * from SubItems where EqpName='" & Replace(cmbtxt, "'", "''") & "'"
Debug.Print strSQL
cnnNew.Execute strSQL
strSQL = "Delete * from Equipment where EqpName='" & Replace(cmbtxt, "'", "''") & "'"
Debug.Print strSQL
cnnNew.Execute strSQL
FlgArea = True: FlgComm = True: FlgPlant = True: FlgEff = True
Call ClearFields(Me)
Call LockFields(Me)
Call DisableButtons(Me)
cmdAddNew.Enabled = True
cmdModify.Enabled = True
cmdExit.Enabled = True
cmdSave.Visible = True
cmbEquipName.Visible = False
txtEquipName.Visible = True
MsgBox "Record Deleted Successfully", vbInformation, "* Record Deleted *"
cmdAddNew.SetFocus
If rst.State = 1 Then rst.Close
Set rst = Nothing
If rsTmp.State = 1 Then rsTmp.Close
Set rsTmp = Nothing
End If
End If
ExitRtn:
Exit Sub
ErrorHandler:
ErrorHandler
Resume ExitRtn
End Sub