Create Multiple Payroll records with one click, Office 2007 (1 Viewer)

[mtn]

I was recently faced with the challange of generating all the payroll for a particular month for all employees before adding any other deductions and earnings individually. This way the process will be faster when I have a lot of employees on the system rather than processing each payroll one after the other.

The code below do all that with a click of a button.

------------------------ Code begin -----------------------------

Public Function GeneratePayroll()

Dim dbsPayroll As DAO.Database
Dim rstEmployees As DAO.Recordset
Dim rstEmployeesPay As Recordset

Dim strSQL As String
Dim strInput As String, strMsg As String

On Error GoTo ErrorHandler

Set dbsPayroll = CurrentDb
Set rstEmployeesPay = dbsPayroll.OpenRecordset("tblPayroll", dbOpenDynaset)


'Open recordsets on the Employees tables. If there are
'no records in either table, exit the function.
strSQL = "SELECT * FROM tblEmployees ORDER BY EmployeeID;"
Set rstEmployees = dbsPayroll.OpenRecordset(strSQL, dbOpenSnapshot)
If rstEmployees.EOF Then Exit Function

'loop through employees until end of file
Do Until rstEmployees.EOF

'Add this record to the payroll table
rstEmployeesPay.MoveFirst
rstEmployeesPay.AddNew
rstEmployeesPay("EmployeeID") = rstEmployees("EmployeeID")

rstEmployeesPay("PaymentMonth") = Forms!frmPayrollRun!PayMonth
rstEmployeesPay("PaymentDate") = Forms!frmPayrollRun!PayDay
rstEmployeesPay("Paid") = Forms!frmPayrollRun!Paid
rstEmployeesPay("PaymentType") = Forms!frmPayrollRun!PayType
rstEmployeesPay("PaymentMethod") = Forms!frmPayrollRun!PayMethod
rstEmployeesPay("Currency") = Forms!frmPayrollRun!Currency
rstEmployeesPay("CostCentre") = Forms!frmPayrollRun!CostCentre

rstEmployeesPay("BasicSalary") = DLookup("BasicSalary", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("MealAllowance") = DLookup("MealAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("TransportAllowance") = DLookup("TransportAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("UtilityAllowance") = DLookup("UtilityAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("EntertainmentAllowance") = DLookup("EntertainmentAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("HousingAllowance") = DLookup("HousingAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
rstEmployeesPay("HazardAllowance") = DLookup("HazardAllowance", "tblEmployeesLevel", "JobLevelID = " & rstEmployees("JobLevelID"))
'rstEmployeesPay("Note") = strInput
rstEmployeesPay("Note") = Forms!frmPayrollRun!Notes
rstEmployeesPay.Update

' Move to the next record.
rstEmployees.MoveNext
Loop

'close and clear the recordset from cache
rstEmployees.Close
rstEmployeesPay.Close
dbsPayroll.Close

Set rstEmployees = Nothing
Set rstEmployeesPay = Nothing
Set dbsPayroll = Nothing

'Inform the user that the payroll has been created.
MsgBox "The payroll has been created successfully for all staff."

Exit Function

ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Function

----------------------------- Code End --------------------------------------------

Once I call the function above, it generates a payslip for all the employees on the employees table with great success.

However, I have another challange or twist to this. I want to be able to also create an additional earning but this time on another table (tblPayrollEarnings) for all the payrollID created above. What I mean is that as the first payroll is created for the first employee from the employees table, a new earning should also be created in the tblPayrollEarnings with this first PayrollID at the click of the same button as the function above.

How can I incorporate the code below into the one above:

--------------------- Code begin -------------------------
Sub PostEarning()

Dim dbEarning As Database
Dim rsEarning As Recordset

Set dbEarning = CurrentDb
Set rsEarning = dbEarning.OpenRecordset("tblPayrollEarnings", DB_OPEN_DYNASET)

rsEarning.AddNew
rsEarning("PayrollID") = rstEmployeesPay("PayrollID")
rsEarning("EarningCategory") = "Overtime"
rsEarning("EarningAmount") = 10000
rsEarning.Update

rsEarning.Close
dbEarning.Close

Set rsEarning = Nothing
Set dbEarning = Nothing

End Sub
----------------------- Code End -------------------------------------

In my immediate code above I used

rsEarning("PayrollID") = rstEmployeesPay("PayrollID")

to capture the new payrollID that I want to post to the tblPayrollEarnings. Does anyone know if that is correct or not. All atempts to combine both codes above have been a nightmare all day. Any help would be appreciated please.

I have attached a stripped down version of my database for anyone that want to assist me.

Many thanks in advance.

 

[DCrake]

Aside from your initial question you could improve the perfomanc with an additional recordset inplace of all those look ups.

 

[vbaInet]

For your first block of code, which DCrake was advising on performance, instead of using a recordset you can use this:

Dim db As DAO.Database
    
Set db = CurrentDb
    
With Forms!frmPayrollRun
    db.Execute "INSERT INTO tblPayroll " & _
                            "(EmployeeID, PaymentMonth, PaymentDate, Paid, PaymentType, PaymentMethod, " & _
                            "[B][COLOR=Red]PayCurrency[/COLOR][/B], CostCentre, BasicSalary, MealAllowance, TransportAllowance, " & _
                            "UtilityAllowance, EntertainmentAllowance, HousingAllowance, HazardAllowance, [COLOR=Red][B]PayNote[/B][/COLOR]) " & _
                      "SELECT EmployeeID, '" & !PayMonth & "' AS PayMo, " & CDate(!PayDay) & " AS PayD, '" & !Paid & "' AS PD, " & _
                                "'" & !PayType & "' AS PayT, '" & !PayMethod & "' AS PayMet, '" & !Currency & "' AS CCren, " & _
                                "'" & !CostCentre & "' AS CostCen, " & _
                                "(SELECT BasicSalary FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS BSal, " & _
                                "(SELECT MealAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS BAllo, " & _
                                "(SELECT TransportAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS TAllo, " & _
                                "(SELECT UtilityAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS UAllo, " & _
                                "(SELECT EntertainmentAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS EAllo, " & _
                                "(SELECT HazardAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS HzAllo, " & _
                                "(SELECT HousingAllowance FROM tblEmployeesLevel WHERE tblEmployeesLevel.JobLevelID = tblEmployees.JobLevelID) AS HoAllo, " & _
                                "'" & !Notes & "' As EmpNotes FROM tblEmployees;", dbFailOnError
End With

That will perform the insert without needing the convoluted DLookups() and recordset. By the way, I changed the name of two fields in the code (highlighted in red) from Currency to PayCurrency and from Note to PayNote. Those two names are RESERVED KEYWORDS in Access and causes problems when used. So if you want the above code working, amend your field names.

In relation to your main question, it depends on how many people are allowed to perform the above function and this as well? Is it just one user who can do this?