ClaRk IntErNati0naL c0LLegE 0f SciENcE & TeChn0l0gY
K.A.L.M. Management Nicholas Santos Thesis Adviser Gr0up II Ashly Jane g0mEz KrisheL Kay AlegRE Liza L0mibA0 Mark Alexander mAmangUN
October 17, 2007 Due date:
Forms
Form name: emp (emp.frm)
Codes: Private Sub Form_Load() DG.Refresh End Sub
Form name: emp_add (entry_add.frm)
Codes: Private Sub Calendar1_Click() txtdoj = Calendar1.Value End Sub Private Sub Command1_Click() Validate_inputs If VALID_FLAG Then TXT1 = "" TXT1 = "insert into employee values('" & txtempcode & "','" _ & txtempname & "','" _ & Combo1.Text & "'," _ & txtphone & ",'" _ & txtaddress & "'," _ & txtpincode & ",'" _ & txtemail & "','" _ & txtdoj & "'," _ & txtmonthlysal & ")" TXT2 = "" TXT2 = "select * from employee where EMP_CODE = '" & Trim(txtempcode) & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT2, CONN, adOpenKeyset, adLockOptimistic 'MsgBox RS.RecordCount If RS.RecordCount > 0 Then MsgBox "Duplicate Entry : The employee code exists in employee table", vbCritical RS.Close Else If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic MsgBox "Successfully added" Clear_all End If ' end of -> If RS.RecordCount > 0 Then End If 'end of VALID_FLAG emp.DG.Refresh End Sub
Private Sub Command2_Click() TXT1 = "" TXT1 = "select * from employee where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic If RS.RecordCount > 0 Then txtempcode = RS.Fields(0) txtempname = RS.Fields(1) Combo1.Text = RS.Fields(2) txtphone = RS.Fields(3) txtaddress = RS.Fields(4) txtpincode = RS.Fields(5) txtemail = RS.Fields(6) txtdoj = RS.Fields(7) txtmonthlysal = RS.Fields(8) Else MsgBox "No matching record found for EMP CODE =" & txtempcode, vbCritical End If RS.Close End Sub Private Sub Command6_Click() End Sub Private Sub Form_Load() Calendar1.Today If CONN.State = 1 Then CONN.Close End If CONN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" CONN.Open TXT1 = "" TXT1 = "select distinct dept_cd from employee" If RS.State = 1 Then
RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic Combo1.Clear Combo1.Text = "" While RS.EOF <> True Combo1.AddItem (RS.Fields(0)) RS.MoveNext Wend RS.Close Clear_all End Sub Public Function Clear_all() txtempcode = "" txtempname = "" 'txtdept = "" txtphone = 0 txtaddress = "" txtpincode = 0 txtemail = "" txtdoj = "" txtmonthlysal = 0 Combo1.Text = "" End Function Public Function Validate_inputs() VALID_FLAG = False If Trim(txtempcode) = "" Then MsgBox "Please enter Employee code" txtempcode.SetFocus ElseIf Trim(txtdoj) = "" Then MsgBox "Date of joining cannot be empty" Combo1.SetFocus ElseIf Trim(txtmonthlysal) = 0 Or Trim(txtmonthlysal) = "" Then MsgBox "Salary : must have some value" txtmonthlysal.SetFocus ElseIf Trim(txtempname) = "" Then MsgBox "Please enter Employee name" txtempname.SetFocus ElseIf Trim(Combo1.Text) = "" Then MsgBox "Please select a Department"
Combo1.SetFocus Else VALID_FLAG = True End If If Trim(txtphone) = "" Then txtphone = 0 End If If Trim(txtpincode) = "" Then txtpincode = 0 End If If Trim(txtmonthlysal) = "" Then txtmonthlysal = 0 End If End Function Private Sub txtmonthlysal_Change() If IsNumeric(txtmonthlysal) = False And Trim(txtmonthlysal) <> "" Then MsgBox "Salary should be only numerics" txtmonthlysal = "" txtmonthlysal.SetFocus End If End Sub Private Sub txtphone_Change() If (IsNumeric(txtphone) = False And Trim(txtphone) <> "") Or InStr(txtphone, ".") Then MsgBox "Phone number should be only numerics" txtphone = "" txtphone.SetFocus End If End Sub Private Sub txtpincode_Change() If (IsNumeric(txtpincode) = False And Trim(txtpincode) <> "") Or InStr(txtphone, ".") Then MsgBox "Pin code should be only numerics" txtpincode = "" txtpincode.SetFocus End If End Sub
Form name: emp_del (empl_del.frm)
Codes: Private Sub Calendar1_Click() txtdoj = Calendar1.Value End Sub Private Sub Command1_Click() End Sub Private Sub Command2_Click() TXT1 = "" TXT1 = "select * from employee where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then
RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic MsgBox TXT1 If RS.RecordCount > 0 Then txtempcode = RS.Fields(0) txtempname = RS.Fields(1) Combo1.Text = RS.Fields(2) txtphone = RS.Fields(3) txtaddress = RS.Fields(4) txtpincode = RS.Fields(5) txtemail = RS.Fields(6) txtdoj = RS.Fields(7) ' TXT1 = "select salary from salary where emp_code ='" & txtempcode & "' and sal_paid = 0 and sal_due = 0" ' If RS.State = 1 Then ' RS.Close ' End If ' RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic txtmonthlysal = RS.Fields(8) Delete.Enabled = True Else MsgBox "No matching record found for EMP CODE =" & txtempcode, vbCritical Delete.Enabled = False End If RS.Close End Sub Private Sub Command6_Click() End Sub Private Sub Delete_Click() If MsgBox("Are you sure to delete?", vbYesNo) = vbYes Then TXT1 = "" TXT1 = "delete from employee where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic
TXT1 = "delete from salary where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic MsgBox "Record deleted Successfully" Clear_all Delete.Enabled = False End If emp.DG.Refresh End Sub Private Sub Form_Load() If CONN.State = 1 Then CONN.Close End If CONN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" CONN.Open Clear_all Delete.Enabled = False End Sub Public Function Clear_all() txtempcode = "" txtempname = "" 'txtdept = "" txtphone = 0 txtaddress = "" txtpincode = 0 txtemail = "" txtdoj = "" txtmonthlysal = 0 Combo1.Text = "" End Function
Form name: emp_upd (empl_upd)
Codes: Private Sub Calendar1_Click() txtdoj = Calendar1.Value End Sub Private Sub Command1_Click() Form_Load Clear_all
txtempcode.Enabled = True Update.Enabled = False End Sub Private Sub Command2_Click() TXT1 = "" TXT1 = "select * from employee where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic 'MsgBox TXT1 If RS.RecordCount > 0 Then txtempcode = RS.Fields(0) txtempname = RS.Fields(1) Combo1.Text = RS.Fields(2) txtphone = RS.Fields(3) txtaddress = RS.Fields(4) txtpincode = RS.Fields(5) txtemail = RS.Fields(6) txtdoj = RS.Fields(7) txtmonthlysal = RS.Fields(8) txtempcode.Enabled = False Update.Enabled = True Else MsgBox "No matching record found for EMP CODE =" & txtempcode, vbCritical End If RS.Close End Sub Private Sub Command6_Click() End Sub Private Sub Form_Load() Calendar1.Today If CONN.State = 1 Then CONN.Close End If
CONN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" CONN.Open TXT1 = "" TXT1 = "select distinct dept_cd from employee" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic Combo1.Text = "" Combo1.Clear While RS.EOF <> True Combo1.AddItem (RS.Fields(0)) RS.MoveNext Wend RS.Close Clear_all Update.Enabled = False End Sub Public Function Clear_all() txtempcode = "" txtempname = "" 'txtdept = "" txtphone = 0 txtaddress = "" txtpincode = 0 txtemail = "" txtdoj = "" txtmonthlysal = 0 Combo1.Text = "" End Function Public Function Validate_inputs() VALID_FLAG = False If Trim(txtempcode) = "" Then MsgBox "Please enter Employee code" txtempcode.SetFocus ElseIf Trim(txtdoj) = "" Then MsgBox "Date of joining cannot be empty"
Combo1.SetFocus ElseIf Trim(txtmonthlysal) = 0 Or Trim(txtmonthlysal) = "" Then MsgBox "Salary : must have some value" txtmonthlysal.SetFocus ElseIf Trim(txtempname) = "" Then MsgBox "Please enter Employee name" txtempname.SetFocus ElseIf Trim(Combo1.Text) = "" Then MsgBox "Please select a Department" Combo1.SetFocus Else VALID_FLAG = True End If If Trim(txtphone) = "" Then txtphone = 0 End If If Trim(txtpincode) = "" Then txtpincode = 0 End If If Trim(txtmonthlysal) = "" Then txtmonthlysal = 0 End If End Function Private Sub txtmonthlysal_Change() If IsNumeric(txtmonthlysal) = False And Trim(txtmonthlysal) <> "" Then MsgBox "Salary should be only numerics" txtmonthlysal = "" txtmonthlysal.SetFocus End If End Sub Private Sub txtphone_Change() If (IsNumeric(txtphone) = False And Trim(txtphone) <> "") Or InStr(txtphone, ".") Then MsgBox "Phone number should be only numerics" txtphone = "" txtphone.SetFocus End If End Sub Private Sub txtpincode_Change() If (IsNumeric(txtpincode) = False And Trim(txtpincode) <> "") Or InStr(txtphone, ".") Then MsgBox "Pin code should be only numerics" txtpincode = ""
txtpincode.SetFocus End If End Sub Private Sub Update_Click() Validate_inputs If VALID_FLAG Then If MsgBox("Are you sure to update?", vbYesNo) = vbYes Then TXT1 = "" TXT1 = "Update employee set EMP_NAME = '" _ & txtempname & "', DEPT_CD = '" _ & Combo1.Text & "', PHONE = " _ & txtphone & ", ADDRESS = '" _ & txtaddress & "', PIN_CODE = " _ & txtpincode & ", EMAIL = '" _ & txtemail & "', DOJ = '" _ & txtdoj & "' , SALARY = " & txtmonthlysal & " where EMP_CODE = '" & txtempcode & "'" MsgBox TXT1 If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic MsgBox "Successfully updated" Clear_all txtempcode.Enabled = True Update.Enabled = False End If End If 'end of VALID_FLAG End Sub
Form name : Frm1 (Frm1.frm) Codes:
Private Sub Timer1_Timer() ProgressBar1.Value = ProgressBar1.Value + 2 Label2.Caption = ProgressBar1.Value & "%" If ProgressBar1.Value = 100 Then login.Show Unload Me End If End Sub
Form name: login(login.frm) Codes: Private Sub Command1_Click() If (LCase(Text1.Text)) = "admin" And (LCase(Text2.Text)) = "payroll" Then Unload Me MDIForm1.Show Else MsgBox "Please Enter Correct Username and Password" End If End Sub Private Sub Command2_Click() End End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Text2.Text = "payroll" Then MDIForm1.Show Unload Me Else msg = MsgBox("PLEASE ENTER THE CORRECT PASSWORD", vbOKCancel, "K.A.L.M. MANAGEMENT") End If End If End Sub
Form name: MDIForm1(MDIForm1.frm)
Codes:
Private Sub about_Click() MsgBox " this is a payroll system software" & vbNewLine & "" _ &" programmed by:K.A.L.M. MANAGEMENT" End Sub Private Sub add_Click() emp_add.Show End Sub Private Sub Delete_Click() emp_del.Show End Sub Private Sub details_Click() emp.Show End Sub Private Sub empentry_Click() 'entry.Show End Sub Private Sub mnulogout_Click() login.Show Unload Me End Sub Private Sub payment_Click() salary.Show End Sub Private Sub quit_Click() End End Sub Private Sub Update_Click() emp_upd.Show End Sub
Form name: salary(salary.frm)
Codes: Dim DOJ As Date Dim NoOfDays As Integer Dim SalaryDue As Double Private Sub Calendar1_Click() txtdosal = Calendar1.Value End Sub Private Sub cmdPAY_Click() If Trim(txtspaid) = "" Then MsgBox "Please enter the Amount to be paid" Exit Sub End If If IsNumeric(txtspaid) = False And Trim(txtspaid) <> "" Then MsgBox "Salary should be only numerics" txtspaid = "" txtspaid.SetFocus End If If MsgBox("Are to sure to pay?", vbYesNo) = vbYes Then SalaryDue = Val(Val(txtsdue) - Val(txtspaid)) 'MsgBox SalaryDue TXT1 = "" TXT1 = "insert into salary values('" & txtempcode & "'," & txtsdue & "," & txtspaid & "," & SalaryDue & ",'" & txtdosal & "')" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic MsgBox "Salary paid" Show_grid txtspaid = "" End If cmdPAY.Enabled = False End Sub
Private Sub Command1_Click() 'cmdPAY.Enabled = True TXT1 = "" TXT1 = "select * from employee where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic If RS.RecordCount > 0 Then Show_grid If DateDiff("d", RS.Fields(7), txtdosal) < 0 Then cmdPAY.Enabled = False MsgBox "DOJ is greater than date of calculation", vbCritical Else txtempcode = RS.Fields(0) txtempname = RS.Fields(1) txtdept = RS.Fields(2) txtsalary = RS.Fields(8) DOJ = RS.Fields(7) TXT1 = "" TXT1 = "select * from salary where EMP_CODE = '" & txtempcode & "'" If RS.State = 1 Then RS.Close End If RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic If RS.RecordCount = 0 Then ' means No salary paid so far, hence calculate from DOJ NoOfDays = DateDiff("d", DOJ, txtdosal) + 1 MsgBox NoOfDays txtsdue = (Val(txtsalary) / 30) * NoOfDays Else ' means : Atleast one time salary is paid TXT1 = "" TXT1 = "select last_dop,sal_paid,sal_due from salary where EMP_CODE = '" & txtempcode & "' order by LAST_DOP desc" If RS.State = 1 Then RS.Close End If
RS.Open TXT1, CONN, adOpenKeyset, adLockOptimistic txtlastdop = RS.Fields(0) txtLASTPAID = RS.Fields(1) NoOfDays = DateDiff("d", txtlastdop, txtdosal) MsgBox NoOfDays txtsdue = (Val(txtsalary) / 30) * NoOfDays + Val(RS.Fields(2)) 'RS.Fields(2) = sal_due End If If Val(txtsdue) > 0 Then cmdPAY.Enabled = True Else cmdPAY.Enabled = False End If End If Else MsgBox "No matching record found for EMP CODE =" & txtempcode, vbCritical End If RS.Close End Sub Private Sub Form_Load() Calendar1.Today If CONN.State = 1 Then CONN.Close End If CONN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" CONN.Open Clear_all txtdosal = Date cmdPAY.Enabled = False End Sub Public Function Clear_all() txtempcode = ""
txtempname = "" txtsalary = "" txtdosal = "" txtspaid = "" txtsdue = "" txtlastdop = "" End Function Public Function Show_grid() Adodc1.RecordSource = "select * from salary where emp_code='" & txtempcode & "' order by last_dop desc" Adodc1.Refresh DataGrid1.Refresh End Function
Modules A module is essentially a collection of declarations, statements, and procedures stored together as one named unit to organize your Microsoft Visual Basic (Microsoft Visual Basic is a high-level, visual-programming version of Basic. Visual Basic was developed by Microsoft for building Windows-based applications.) code. Microsoft Access has two types of modules: standard modules and class modules (class module is a module that can contain the definition for a new object. Each instance of a class creates a new object. Procedures defined in the module become properties and methods of the object. Class modules can exist alone or with forms and reports.).
Module name: Module1(Payroll.bas) Codes: '****** 'MODULE '****** 'PUBLIC VARIABLE DECLARATION Global CONN As New ADODB.Connection Global RS As New ADODB.Recordset Global CMD As New ADODB.Command Global TXT1, TXT2 As Variant Global VALID_FLAG As Boolean
Designers
DataEnvironment1(DE1.Dsr)