newbie2005
02-08-2005, 05:33 AM
Im working on two recordsets here for the computation of payroll. One of which contains the emp id and the emp name and the payperiod and the other contains all the payroll information. Now, my prob here is that, no data would show except for the emp number. (im working an access database)
Please help out. Tnx.
here's the code:
Public dwCommand As String
Dim mvBookMark As Variant
Dim mbDataChanged As Boolean
Dim mbEditFlag As Boolean
Dim WithEvents adoPrimary As Recordset
Dim WithEvents adoPrimary2 As Recordset
Private Sub cmdUpdate_Click()
On Error GoTo ComErr
Dim Payment1 As Single
Dim Payment2 As Single
Dim Payment3 As Single
Dim Payment4 As Single
Dim Payment5 As Single
Dim Payment6 As Single
Dim Payment7 As Single
Dim Calc1 As Single
Dim Calc2 As Single
Dim Calc3 As Single
Dim gpay As Single
Dim npaymo As Single
'for total allowance
Calc1 = txtFields(20).Text + txtFields(21).Text + txtFields(22).Text
'for grosspay
gpay = adoPrimary2![BasicPay] + Calc1
'computation for loan payments
'for salary loan
Payment1 = Pmt(0.01 * txtFields(3).Text / 12, txtFields(4).Text, txtFields(24).Text)
'for policy loan
Payment2 = Pmt(0.01 * txtFields(15).Text / 12, txtFields(16).Text, txtFields(14).Text)
'optional premium
Payment3 = Pmt(0.01 * txtFields(35).Text / 12, txtFields(30).Text, txtFields(8).Text)
'for philhealth/med
Payment4 = txtFields(17).Text
'for insurance
Payment5 = txtFields(18).Text
'for optional insurance
Payment6 = Pmt(0.01 * txtFields(9).Text / 12, txtFields(10).Text, txtFields(34).Text)
'for total other deductions
Payment7 = txtFields(7).Text + txtFields(11).Text + txtFields(12).Text + txtFields(13).Text + txtFields(5).Text + txtFields(6).Text
'for total deduction
Calc2 = Payment1 + Payment2 + Payment3 + Payment4 + Payment5 + Payment6 + Payment7
'for netpay
npaymo = gpay - Calc2
Calc3 = npaymo / 2
txtFields(2).Text = Payment1 'salary loan payment
txtFields(28).Text = Payment2 'policy loan payment
txtFields(29).Text = Payment3 'philhealth/med
txtFields(26).Text = Payment4 'optional insurance
txtFields(31).Text = Calc1 'total allowance
txtFields(32).Text = Calc2 'total deduction
txtFields(33).Text = Calc3 'netincome
Exit Sub
With adoPrimary2
![SalaryLoan_Pay] = txtFields(2).Text
![OptionalPrem_Pay] = txtFields(26).Text
![PolicyLoan_Pay] = txtFields(28).Text
![Premium_Pay] = txtFields(29).Text
![ODed1] = txtFields(11).Text
![ODed2] = txtFields(7).Text
![ODed3] = txtFields(12).Text
![ODed4] = txtFields(13).Text
![ODed5] = txtFields(5).Text
![ODed6] = txtFields(6).Text
![GrossPay] = gpay
![Allowance] = txtFields(31).Text
![Deduction] = txtFields(32).Text
![NetIncome] = txtFields(33).Text
![SalPayableIn] = txtFields(4).Text
![OptPayableIn] = txtFields(10).Text
![PolPayableIn] = txtFields(14).Text
![IRateSal] = txtFields(3).Text
![IRatePer] = txtFields(12).Text
![IRateOpt] = txtFields(9).Text
![IRatePag] = txtFields(6).Text
![IRatePol] = txtFields(15).Text
.Update
End With
adoPrimary.Requery
If mbEditFlag Then
adoPrimary.MoveLast
adoPrimary2.MoveLast
End If
mbEditFlag = False
mbDataChanged = False
cmdRefresh_Click
adoPrimary.MoveLast
adoPrimary2.MoveLast
cmdCancel.Visible = False
cmdUpdate.Visible = False
Dim oText As TextBox
For Each oText In Me.txtFields
oText.Locked = False
Next oText
ComErr:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
App.Path & "\Payroll.mdb;"
Set adoPrimary = New Recordset
adoPrimary.Open "SELECT ([LName] & ',' & chr(32) & [FName]& chr(32) & [MInitial]) as Name, [Num], [PayDate] FROM tblPayroll", _
db, adOpenStatic, adLockOptimistic
Set adoPrimary2 = New Recordset
adoPrimary2.Open "SELECT Allowance,Deduction,RATA, ACA,PERA," _
& "GrossPay, NetIncome,SalaryLoan," _
& "PolicyLoan, Premium, OptionalPrem,Tax," _
& "GSIS, PhilHealthMed, SalaryLoan_Pay," _
& "PolicyLoan_Pay,OptionalPrem_Pay,Premium_Pay," _
& "ODed1, ODed2, ODed3, ODed4, ODed5, ODed6, ODed," _
& "IRateSal,IRatePer, IRatePol, IRateOpt,IRatePre," _
& "SalPayableIn, PerPayableIn, PolPayableIn," _
& "OptPayableIn, PrePayableIn FROM tblDedAllow", _
db, adOpenStatic, adLockOptimistic
Dim Index As Integer
Select Case Index
Case 0 To 1
Set txtFields(Index).DataSource = adoPrimary
Case 2 To 35
Set txtFields(Index).DataSource = adoPrimary2
End Select
End Sub
Private Sub adoPrimary_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
lblStatus.Caption = "Record: " & CStr(adoPrimary.AbsolutePosition)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If mbEditFlag Then Exit Sub
Select Case KeyCode
Case vbKeyEscape
cmdClose_Click
Case vbKeyEnd
cmdLast_Click
Case vbKeyHome
cmdFirst_Click
Case vbKeyUp, vbKeyPageUp
If Shift = vbCtrlMask Then
cmdFirst_Click
Else
cmdPrevious_Click
End If
Case vbKeyDown, vbKeyPageDown
If Shift = vbCtrlMask Then
cmdLast_Click
Else
cmdNext_Click
End If
End Select
End Sub
Private Sub cmdFirst_Click()
On Error GoTo GoFirstError
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
mbDataChanged = False
Exit Sub
GoFirstError:
MsgBox Err.Description
End Sub
Private Sub cmdLast_Click()
On Error GoTo GoLastError
adoPrimary.MoveLast
adoPrimary2.MoveLast
mbDataChanged = False
Exit Sub
GoLastError:
MsgBox Err.Description
End Sub
Private Sub cmdNext_Click()
On Error GoTo GoNextError
If Not adoPrimary.EOF And Not adoPrimary2.EOF Then
adoPrimary.MoveNext
adoPrimary2.MoveNext
If adoPrimary.EOF And adoPrimary.RecordCount > 0 Then
If adoPrimary2.EOF And adoPrimary2.RecordCount > 0 Then
Beep
adoPrimary.MoveLast
adoPrimary2.MoveLast
End If
End If
End If
mbDataChanged = False
Exit Sub
GoNextError:
MsgBox Err.Description
End Sub
Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError
If Not adoPrimary.BOF And Not adoPrimary2.BOF Then
adoPrimary.MovePrevious
adoPrimary2.MovePrevious
If adoPrimary.BOF And adoPrimary.RecordCount > 0 Then
If adoPrimary2.BOF And adoPrimary2.RecordCount > 0 Then
Beep
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
End If
End If
End If
mbDataChanged = False
Exit Sub
GoPrevError:
MsgBox Err.Description
End Sub
Private Sub cmdEdit_Click()
Dim oText As TextBox
For Each oText In Me.txtFields
oText.Locked = False
Next oText
mbEditFlag = True
cmdUpdate.Visible = True
cmdCancel.Visible = True
cmdCancel.Cancel = True
Exit Sub
End Sub
Private Sub cmdFind_Click()
frmFind.Show vbModal, Me
If frmFind.sRet <> vbNullString Then
GetEmployee frmFind.sRet, IIf(Not IsNumeric(frmFind.sRet), 1, 0)
End If
End Sub
Private Sub cmdCancel_Click()
cmdUpdate.Visible = False
mbEditFlag = False
adoPrimary.CancelUpdate
adoPrimary2.CancelUpdate
If mvBookMark > 0 Then
adoPrimary.Bookmark = mvBookMark
adoPrimary2.Bookmark = mvBookMark
Else
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
End If
cmdClose.Cancel = True
cmdCancel.Visible = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
Select Case Index
Case 2 To 35
txtFields(Index).Text = (Format(txtFields(Index).Text, "#.00"))
Case 23
txtFields(Index).Text = (Format(txtFields(Index).Text, "dd/mm/yyyy"))
End Select
End Sub
Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
Dim IsError As Boolean
Select Case Index
Case 2 To 35
If txtFields(Index).Text <> "" Then
If Not IsNumeric(txtFields(Index).Text) Then
MsgBox "Please enter a number!", _
vbInformation, "Quantity"
IsError = True
ElseIf Val(txtFields(Index).Text) < 0 Then
MsgBox "Invalid input", vbInformation, "Quantity"
IsError = True
End If
If IsError Then
Cancel = True
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(txtFields(Index).Text)
End If
End If
End Select
End Sub
Private Sub GetEmployee(ItemKey As String, Optional opt As Integer = 0)
Dim varBookmark As Variant
With adoPrimary
varBookmark = .Bookmark
.MoveLast
.MoveFirst
Select Case opt
Case Is = 0
.Find "[Num] = '" & ItemKey & "'"
Case Is = 1
.Find "[Name] = '" & ItemKey & "'"
End Select
If .EOF Then
.Bookmark = varBookmark
MsgBox "Record does not exist!", vbExclamation
Else
End If
End With
End Sub
Private Sub cmdRefresh_Click()
mbEditFlag = False
mbDataChanged = False
End Sub
Please help out. Tnx.
here's the code:
Public dwCommand As String
Dim mvBookMark As Variant
Dim mbDataChanged As Boolean
Dim mbEditFlag As Boolean
Dim WithEvents adoPrimary As Recordset
Dim WithEvents adoPrimary2 As Recordset
Private Sub cmdUpdate_Click()
On Error GoTo ComErr
Dim Payment1 As Single
Dim Payment2 As Single
Dim Payment3 As Single
Dim Payment4 As Single
Dim Payment5 As Single
Dim Payment6 As Single
Dim Payment7 As Single
Dim Calc1 As Single
Dim Calc2 As Single
Dim Calc3 As Single
Dim gpay As Single
Dim npaymo As Single
'for total allowance
Calc1 = txtFields(20).Text + txtFields(21).Text + txtFields(22).Text
'for grosspay
gpay = adoPrimary2![BasicPay] + Calc1
'computation for loan payments
'for salary loan
Payment1 = Pmt(0.01 * txtFields(3).Text / 12, txtFields(4).Text, txtFields(24).Text)
'for policy loan
Payment2 = Pmt(0.01 * txtFields(15).Text / 12, txtFields(16).Text, txtFields(14).Text)
'optional premium
Payment3 = Pmt(0.01 * txtFields(35).Text / 12, txtFields(30).Text, txtFields(8).Text)
'for philhealth/med
Payment4 = txtFields(17).Text
'for insurance
Payment5 = txtFields(18).Text
'for optional insurance
Payment6 = Pmt(0.01 * txtFields(9).Text / 12, txtFields(10).Text, txtFields(34).Text)
'for total other deductions
Payment7 = txtFields(7).Text + txtFields(11).Text + txtFields(12).Text + txtFields(13).Text + txtFields(5).Text + txtFields(6).Text
'for total deduction
Calc2 = Payment1 + Payment2 + Payment3 + Payment4 + Payment5 + Payment6 + Payment7
'for netpay
npaymo = gpay - Calc2
Calc3 = npaymo / 2
txtFields(2).Text = Payment1 'salary loan payment
txtFields(28).Text = Payment2 'policy loan payment
txtFields(29).Text = Payment3 'philhealth/med
txtFields(26).Text = Payment4 'optional insurance
txtFields(31).Text = Calc1 'total allowance
txtFields(32).Text = Calc2 'total deduction
txtFields(33).Text = Calc3 'netincome
Exit Sub
With adoPrimary2
![SalaryLoan_Pay] = txtFields(2).Text
![OptionalPrem_Pay] = txtFields(26).Text
![PolicyLoan_Pay] = txtFields(28).Text
![Premium_Pay] = txtFields(29).Text
![ODed1] = txtFields(11).Text
![ODed2] = txtFields(7).Text
![ODed3] = txtFields(12).Text
![ODed4] = txtFields(13).Text
![ODed5] = txtFields(5).Text
![ODed6] = txtFields(6).Text
![GrossPay] = gpay
![Allowance] = txtFields(31).Text
![Deduction] = txtFields(32).Text
![NetIncome] = txtFields(33).Text
![SalPayableIn] = txtFields(4).Text
![OptPayableIn] = txtFields(10).Text
![PolPayableIn] = txtFields(14).Text
![IRateSal] = txtFields(3).Text
![IRatePer] = txtFields(12).Text
![IRateOpt] = txtFields(9).Text
![IRatePag] = txtFields(6).Text
![IRatePol] = txtFields(15).Text
.Update
End With
adoPrimary.Requery
If mbEditFlag Then
adoPrimary.MoveLast
adoPrimary2.MoveLast
End If
mbEditFlag = False
mbDataChanged = False
cmdRefresh_Click
adoPrimary.MoveLast
adoPrimary2.MoveLast
cmdCancel.Visible = False
cmdUpdate.Visible = False
Dim oText As TextBox
For Each oText In Me.txtFields
oText.Locked = False
Next oText
ComErr:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
App.Path & "\Payroll.mdb;"
Set adoPrimary = New Recordset
adoPrimary.Open "SELECT ([LName] & ',' & chr(32) & [FName]& chr(32) & [MInitial]) as Name, [Num], [PayDate] FROM tblPayroll", _
db, adOpenStatic, adLockOptimistic
Set adoPrimary2 = New Recordset
adoPrimary2.Open "SELECT Allowance,Deduction,RATA, ACA,PERA," _
& "GrossPay, NetIncome,SalaryLoan," _
& "PolicyLoan, Premium, OptionalPrem,Tax," _
& "GSIS, PhilHealthMed, SalaryLoan_Pay," _
& "PolicyLoan_Pay,OptionalPrem_Pay,Premium_Pay," _
& "ODed1, ODed2, ODed3, ODed4, ODed5, ODed6, ODed," _
& "IRateSal,IRatePer, IRatePol, IRateOpt,IRatePre," _
& "SalPayableIn, PerPayableIn, PolPayableIn," _
& "OptPayableIn, PrePayableIn FROM tblDedAllow", _
db, adOpenStatic, adLockOptimistic
Dim Index As Integer
Select Case Index
Case 0 To 1
Set txtFields(Index).DataSource = adoPrimary
Case 2 To 35
Set txtFields(Index).DataSource = adoPrimary2
End Select
End Sub
Private Sub adoPrimary_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
lblStatus.Caption = "Record: " & CStr(adoPrimary.AbsolutePosition)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If mbEditFlag Then Exit Sub
Select Case KeyCode
Case vbKeyEscape
cmdClose_Click
Case vbKeyEnd
cmdLast_Click
Case vbKeyHome
cmdFirst_Click
Case vbKeyUp, vbKeyPageUp
If Shift = vbCtrlMask Then
cmdFirst_Click
Else
cmdPrevious_Click
End If
Case vbKeyDown, vbKeyPageDown
If Shift = vbCtrlMask Then
cmdLast_Click
Else
cmdNext_Click
End If
End Select
End Sub
Private Sub cmdFirst_Click()
On Error GoTo GoFirstError
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
mbDataChanged = False
Exit Sub
GoFirstError:
MsgBox Err.Description
End Sub
Private Sub cmdLast_Click()
On Error GoTo GoLastError
adoPrimary.MoveLast
adoPrimary2.MoveLast
mbDataChanged = False
Exit Sub
GoLastError:
MsgBox Err.Description
End Sub
Private Sub cmdNext_Click()
On Error GoTo GoNextError
If Not adoPrimary.EOF And Not adoPrimary2.EOF Then
adoPrimary.MoveNext
adoPrimary2.MoveNext
If adoPrimary.EOF And adoPrimary.RecordCount > 0 Then
If adoPrimary2.EOF And adoPrimary2.RecordCount > 0 Then
Beep
adoPrimary.MoveLast
adoPrimary2.MoveLast
End If
End If
End If
mbDataChanged = False
Exit Sub
GoNextError:
MsgBox Err.Description
End Sub
Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError
If Not adoPrimary.BOF And Not adoPrimary2.BOF Then
adoPrimary.MovePrevious
adoPrimary2.MovePrevious
If adoPrimary.BOF And adoPrimary.RecordCount > 0 Then
If adoPrimary2.BOF And adoPrimary2.RecordCount > 0 Then
Beep
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
End If
End If
End If
mbDataChanged = False
Exit Sub
GoPrevError:
MsgBox Err.Description
End Sub
Private Sub cmdEdit_Click()
Dim oText As TextBox
For Each oText In Me.txtFields
oText.Locked = False
Next oText
mbEditFlag = True
cmdUpdate.Visible = True
cmdCancel.Visible = True
cmdCancel.Cancel = True
Exit Sub
End Sub
Private Sub cmdFind_Click()
frmFind.Show vbModal, Me
If frmFind.sRet <> vbNullString Then
GetEmployee frmFind.sRet, IIf(Not IsNumeric(frmFind.sRet), 1, 0)
End If
End Sub
Private Sub cmdCancel_Click()
cmdUpdate.Visible = False
mbEditFlag = False
adoPrimary.CancelUpdate
adoPrimary2.CancelUpdate
If mvBookMark > 0 Then
adoPrimary.Bookmark = mvBookMark
adoPrimary2.Bookmark = mvBookMark
Else
adoPrimary.MoveFirst
adoPrimary2.MoveFirst
End If
cmdClose.Cancel = True
cmdCancel.Visible = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
Select Case Index
Case 2 To 35
txtFields(Index).Text = (Format(txtFields(Index).Text, "#.00"))
Case 23
txtFields(Index).Text = (Format(txtFields(Index).Text, "dd/mm/yyyy"))
End Select
End Sub
Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
Dim IsError As Boolean
Select Case Index
Case 2 To 35
If txtFields(Index).Text <> "" Then
If Not IsNumeric(txtFields(Index).Text) Then
MsgBox "Please enter a number!", _
vbInformation, "Quantity"
IsError = True
ElseIf Val(txtFields(Index).Text) < 0 Then
MsgBox "Invalid input", vbInformation, "Quantity"
IsError = True
End If
If IsError Then
Cancel = True
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(txtFields(Index).Text)
End If
End If
End Select
End Sub
Private Sub GetEmployee(ItemKey As String, Optional opt As Integer = 0)
Dim varBookmark As Variant
With adoPrimary
varBookmark = .Bookmark
.MoveLast
.MoveFirst
Select Case opt
Case Is = 0
.Find "[Num] = '" & ItemKey & "'"
Case Is = 1
.Find "[Name] = '" & ItemKey & "'"
End Select
If .EOF Then
.Bookmark = varBookmark
MsgBox "Record does not exist!", vbExclamation
Else
End If
End With
End Sub
Private Sub cmdRefresh_Click()
mbEditFlag = False
mbDataChanged = False
End Sub