Option Explicit
Dim rsStocks As ADODB.Recordset
Dim sSQL$
Private Sub cmdAdd_Click()
If CheckNullValue = False Then Exit Sub
cmdCancel.Enabled = True
'lstStocks.Enabled = False
txtCode.SetFocus
On Error GoTo errHandler
With oConn
.BeginTrans
' - save to tblStocks -
'--------------------------------------------------------------
.Execute "INSERT INTO tblStocks(Code, ProductDescription, UnitPrice, " & _
"Quantity, ReOrder)" & _
"VALUES('" & txtCode.Text & "', '" & txtDesc.Text & "', '" & _
txtUnitPrice.Text & "' ,'" & txtQty.Text & "','" & _
txtROP.Text & "')", , adCmdText
'==============================================================
.CommitTrans
End With
Call ClearFunction(frmStocks, "TextBox")
Exit Sub
errHandler:
oConn.RollbackTrans
Call msgError(Err)
End Sub
Private Sub cmdCancel_Click()
Call ClearFunction(frmStocks, "TextBox")
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_Load()
Call openConnection
Me.Left = LeftPos
Me.Top = TopPos
Set rsStocks = New ADODB.Recordset
rsStocks.CursorLocation = adUseClient
sSQL = "SELECT * FROM tblStocks"
If rsStocks.State = adStateOpen Then rsStocks.Close
rsStocks.Open sSQL, oConn, adOpenStatic, adLockOptimistic
Call FillListView
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rsStocks.State = adStateOpen Then rsStocks.Close
Set rsStocks = Nothing
End Sub
'TODO : return true if all required field has been filled
Private Function CheckNullValue() As Boolean
CheckNullValue = False
If Len(Trim$(txtCode.Text)) = 0 Then
Call msgMustBeFilled("Product Code")
txtCode.SetFocus
Exit Function
ElseIf Len(Trim$(txtDesc.Text)) = 0 Then
Call msgMustBeFilled("Description")
txtDesc.SetFocus
Exit Function
ElseIf Len(Trim$(txtUnitPrice.Text)) = 0 Then
Call msgMustBeFilled("Unit Price")
txtUnitPrice.SetFocus
Exit Function
ElseIf Len(Trim$(txtQty.Text)) = 0 Then
Call msgMustBeFilled("Quantity")
txtQty.SetFocus
Exit Function
ElseIf Len(Trim$(txtROP.Text)) = 0 Then
Call msgMustBeFilled("Re-Order Point")
txtROP.SetFocus
Exit Function
End If
'If cmdAddCategory.Enabled = True Then Call ReplaceQuotation(txtCategoryName)
CheckNullValue = True
End Function
Sub FillListView(lstStocks As ListView, rsStocks As ADODB.Recordset, Optional ImgNum As Long = 0)
lstStocks.ListItems.Clear
If Not rsStocks.BOF Then
rsStocks.MoveFirst
Dim a As Long
Dim lst As ListItem
While Not rsStocks.EOF
lst.Ghosted = True
Set lst = lstStocks.ListItems.Add(, , rsStocks.Fields(0).Value, , ImgNum)
For a = 1 To lv.ColumnHeaders.Count - 1
lst.SubItems(a) = rsStocks.Fields(a).Value
Next
rsStocks.MoveNext
Wend
End If
End Sub