<% ' MyPAYE ' Module: ImportEarningsData.asp ' ' This software is the copyright of Mr T J Sheppard and may not be copied, duplicated or ' modified other than as permitted in the licence agreement. ' ' © 2012 - 2023 Mr T J Sheppard ' Lyndale House ' Church Street ' Bradwell ' Hope Valley ' S33 9HJ ' ' Tel 0845 643 5191 ' Email Support@MyPAYE.co.uk ' ' MyPAYE is a Registered Trademark of MyPAYE Ltd '------------------------------------------------------------------- ' ' Updated 22 April 2023 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Description - This module processes uploads an Employee Earnings Import file ' ' Amendment Log '------------------------------------------------------------------------------------------ ' Date | Name | Vers. | Description '------------------------------------------------------------------------------------------ ' 20/11/14 | TJS | 4.0.07 | Page added ' 22/04/15 | DC | 4.0.13 | Corrected some field logic checks. ' 02/03/16 | DC | 5.0.03 | Not detecting a single '-' as invalid. ' 09/07/16 | TJS | 5.0.12 | Removed references to ArchiveFlag field ' 16/04/18 | TJS | 5.2.03 | Modified to only check Exclude_this_period flag when finding employee ' | if Automatically exclude Employees with Zero Earnings is not set ' 29/04/18 | TJS | 5.2.04 | Added extra activity log identifier and modified to set or clear the Exclude_this_period flag for ' | employees who have earnings imported when Automatically exclude Employees with Zero Earnings is active ' 15/09/18 | TJS | 5.4.01 | Modified Employee_Pay_Items sql to optimise use of amended indexes ' 17/06/18 | TJS | 5.5.10 | Modified to identify missing header columns by name and corrected code removing trailing spaces on field names ' 23/06/19 | TJS | 5.5.11 | Modified to cater for import errors file ' 24/07/19 | TJS | 5.5.14 | Added detection for column count not being in groups of 3 plus ID columns ' 27/07/19 | TJS | 5.5.14a | Modified to remove leading and trailing spaces on ID column values ' 06/04/20 | TJS | 5.7.07 | Modified to cater for & in pay item names ' 30/05/20 | TJS | 5.8.00 | Modified to replace stylesheet.css, mainmenu.css and buttons-css.asp with BodyAndMenu-css.asp and modified to set Input_Data_Changed flag on payroll for status display on payroll home ' 10/09/21 | TJS | 5.9.11 | Modified to replace alert and confirm dialogues to cater for browser blocks on cross site dialogs ' 15/10/21 | TJS | 5.9.13 | Corrected position of closing to report results ' 24/12/22 | TJS | 5.9.20 | Modified to include sql for ID mismatch errors if user has debug enabled and to cater for field list not having enclosing quote characters. ' | Also modified to highlight excluded employees rether that dispay not found error. ' 23/01/23 | TJS | 5.9.21 | Disabled Response Buffering as caused occasional errors and modified to run in iframe in SelectPayrollForEarnImport.asp to overcome issues with window.opener not working on Chrome and some other browsers ' 22/04/23 | TJS | 5.9.24 | Modified to detect files with only CR or LF as line termination and display an appropriate error message. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PageID = 75416 NoBack = False Dim oPseudoRequest, element, i, bTest, RowErrorMessage, bImportError, FileURL ' TJS 23/06/19 Set oPseudoRequest = new PseudoRequestDictionary on error resume next oPseudoRequest.ReadRequest() if err.number <> 0 then on error goto 0%> Upload Employee Earnings File Error <%response.end end if oPseudoRequest.ReadQuerystring(Request.Querystring) SessionID = oPseudoRequest.Form("ID") SessionVarsID = RemoveHTML(oPseudoRequest.Form("SV")) SourceFrame = RemoveHTML(oPseudoRequest.Form("S")) DestFrame = RemoveHTML(oPseudoRequest.Form("D")) EmployerID = CheckURLDBIDField(RemoveHTML(oPseudoRequest.form("ER")), "EmployerID") PayrollID = CheckURLDBIDField(RemoveHTML(oPseudoRequest.form("PR")), "PayrollID") CarryForward = RemoveHTML(oPseudoRequest.form("CarryFwd")) %> <%GetSessionVarsIDRecord(SessionVarsID)%> <% Server.ScriptTimeOut = 300 ' start of code added TJS 23/06/19 sub CompleteErrorsFile(FromLineNo, EndOfFileMessage) for iLoop = FromLineNo to iImportLineCount ErrorsFile = ErrorsFile & sImportLines(iLoop) & vbcrlf next ErrorsFile = ErrorsFile & vbcrlf & EndOfFileMessage SaveErrorsFile end sub sub SaveErrorsFile() set objFSO = CreateObject("Scripting.FileSystemObject") WebRoot = Server.Mappath("/") FilePath = WebRoot & "\Secure\ImportResults\" set TypeLib = Server.CreateObject("Scriptlet.TypeLib") newGUID = TypeLib.Guid set TypeLib = nothing FileName = "E" & EmployerID & "-" & mid(newGUID, 2, len(newGUID) - 4) & "_Earnings_Import_with_Errors.csv" on error resume next if objFSO.FileExists(FilePath & FileName) then Set objXMLFile = objFSO.OpenTextFile(FilePath & FileName, 2) else Set objXMLFile = objFSO.CreateTextFile(FilePath & FileName) end if objXMLFile.Write ErrorsFile objXMLFile.close on error goto 0 Set objXMLFile = nothing set objFSO = nothing FileURL = "https://" & request.servervariables("SERVER_NAME") & "/Secure/ImportResults/" & FileName sql = "UPDATE " &DBSchema & "Employers SET Import_Result_File_Exists = -1 WHERE Employer_ID = " & EmployerID ExecuteSQL objConn, sql end sub sub AddToRowErrorMsg(ErrorText) if "" & RowErrorMessage <> "" then RowErrorMessage = RowErrorMessage & ", " end if RowErrorMessage = RowErrorMessage & ErrorText bImportError = true end sub function GetExcelColumnLetter(ColumnNumber) GetExcelColumnLetter = "" lTemp = ColumnNumber FirstLetterIndex = 0 do while lTemp > 26 FirstLetterIndex = FirstLetterIndex + 1 lTemp = lTemp - 26 loop if FirstLetterIndex > 0 then GetExcelColumnLetter = chr(asc("A") + (FirstLetterIndex - 1)) end if GetExcelColumnLetter = GetExcelColumnLetter & chr(asc("A") + (lTemp - 1)) end function ' end of code added TJS 23/06/19 FileType = oPseudoRequest.Form("file_1").FileName FileType = right(FileType, 3) uFileType = ucase(FileType)%> Upload Employee Earnings File Error <%if CheckBrowserVersion("MSIE", 8, true, false, false) then ' [if LT IE 8]%> <%end if if CheckBrowserVersion("MSIE", 7, true, true, false) then ' [if lte IE 7]%> <%end if if "" & GetSessionVar("PathModifier") <> "" then%> Partner-CSS.asp" /> <%end if%>

Uploading Employee Earnings File

Progress..
<%'ALLOWED FILETYPE ResponseMessage = "" bImportSuccessful = false ' TJS 10/09/21 FileURL = "" ' TJS 23/06/19 ErrorsFile = "" ' TJS 23/06/19 bImportError = false ' TJS 23/06/19 if uFiletype = "CSV" then%> <%If oPseudoRequest.Form("file_1").ContainsFile Then 'get file data sFileData = oPseudoRequest.Form("file_1").Byte2String(oPseudoRequest.Form("file_1").Binary) sImportLines = Split(sFileData, vbCrLf) iImportLineCount = UBound(sImportLines) if iImportLineCount > 2 then ParseLine sImportLines(0), sFieldList, iFieldCount ' TJS 24/12/22 for iLoop = 0 to iFieldCount ' remove any spaces at start of field name do while left(sFieldList(iLoop), 1) = " " sFieldList(iLoop) = mid(sFieldList(iLoop), 2) loop ' remove any spaces at end of field name do while right(sFieldList(iLoop), 1) = " " sFieldList(iLoop) = left(sFieldList(iLoop), len(sFieldList(iLoop)) - 1) loop ' remove starting and ending " if present if left(sFieldList(iLoop), 1) = """" then sFieldList(iLoop) = mid(sFieldList(iLoop), 2) end if if right(sFieldList(iLoop), 1) = """" then sFieldList(iLoop) = left(sFieldList(iLoop), len(sFieldList(iLoop)) - 1) end if sFieldList(iLoop) = replace(sFieldList(iLoop), "%22", """") sFieldList(iLoop) = replace(sFieldList(iLoop), "%2C", ",") next if iFieldCount > 7 then ParseLine sImportLines(1), sQtyRateList, iQtyRateCount ' TJS 24/12/22 for iLoop = 0 to iQtyRateCount ' remove any spaces at start of field name do while left(sQtyRateList(iLoop), 1) = " " sQtyRateList(iLoop) = mid(sQtyRateList(iLoop), 2) loop ' remove any spaces at end of field name do while right(sQtyRateList(iLoop), 1) = " " sQtyRateList(iLoop) = left(sQtyRateList(iLoop), len(sQtyRateList(iLoop)) - 1) ' TJS 17/06/19 loop ' remove starting and ending " if present if "" & sQtyRateList(iLoop) <> "" then if left(sQtyRateList(iLoop), 1) = """" then sQtyRateList(iLoop) = mid(sQtyRateList(iLoop), 2) end if if right(sQtyRateList(iLoop), 1) = """" then sQtyRateList(iLoop) = left(sQtyRateList(iLoop), len(sQtyRateList(iLoop)) - 1) end if end if sQtyRateList(iLoop) = replace(sQtyRateList(iLoop), "%22", """") sQtyRateList(iLoop) = replace(sQtyRateList(iLoop), "%2C", ",") next if iQtyRateCount = iFieldCount then if sFieldList(0) = "Employee ID" and sFieldList(1) = "Employee Title" and sFieldList(2) = "Employee First Name" and _ sFieldList(3) = "Employee Surname" and sFieldList(4) = "Payroll Ref" and sFieldList(5) = "NI Number" then ' start of code added TJS 23/06/19 for iLoop = 6 to iFieldCount - 1 step 3 ' TJS 24/07/19 on error resume next ' TJS 24/07/19 if Left(sFieldList(iLoop + 1), 4) <> "E - " and Left(sFieldList(iLoop + 1), 4) <> "D - " then AddToRowErrorMsg "Unknown Pay Item Type in field name for Column " & GetExcelColumnLetter(iLoop + 2) & " - must be E or D." bImportError = true end if if err.number > 0 then ' TJS 24/07/19 AddToRowErrorMsg "Column count error" ' TJS 24/07/19 bImportError = true ' TJS 24/07/19 end if on error goto 0 ' TJS 24/07/19 next if not bImportError then ErrorsFile = ErrorsFile & sImportLines(0) & vbcrlf ' TJS 23/06/19 ' end of code added TJS 23/06/19 ' start of code added TJS 16/04/18 sql = "SELECT Exclude_Zero_Pay_Employees FROM " & DBSchema & "Employers WHERE Employer_ID = " & EmployerID set rsEmployer = OpenRecordset(objConn, sql) ' start of code moved and amended TJS 23/06/19 if sQtyRateList(0) = "" and sQtyRateList(1) = "" and sQtyRateList(2) = "" and sQtyRateList(3) = "" and sQtyRateList(4) = "" and sQtyRateList(5) = "" then ' TJS 23/06/19 for iLoop = 6 to iQtyRateCount - 1 step 3 ' TJS 24/07/19 ' check spacer column blank if sQtyRateList(iLoop) <> "" then AddToRowErrorMsg "Column " & GetExcelColumnLetter(iLoop + 1) & " must be blank." bImportError = true end if ' check column Qty/ Rate indicator on error resume next ' TJS 24/07/19 if sQtyRateList(iLoop + 1) <> "Qty" then if sQtyRateList(iLoop + 1) <> "" then AddToRowErrorMsg "Column " & GetExcelColumnLetter(iLoop + 2) & " expected to be a Qty column, but actually is " & sQtyRateList(iLoop + 1) & "." else AddToRowErrorMsg "Column " & GetExcelColumnLetter(iLoop + 2) & " expected to be a Qty column, but actually is blank." end if bImportError = true end if ' check column Qty/ Rate indicator if sQtyRateList(iLoop + 2) <> "Rate" then if sQtyRateList(iLoop + 2) <> "" then AddToRowErrorMsg "Column " & GetExcelColumnLetter(iLoop + 3) & " expected to be a Rate column, but actually is " & sQtyRateList(iLoop + 2) & "." else AddToRowErrorMsg "Column " & GetExcelColumnLetter(iLoop + 3) & " expected to be a Rate column, but actually is blank." end if bImportError = true end if if err.number > 0 then ' TJS 24/07/19 AddToRowErrorMsg "Column count error" ' TJS 24/07/19 bImportError = true ' TJS 24/07/19 end if on error goto 0 ' TJS 24/07/19 next if not bImportError then ErrorsFile = ErrorsFile & sImportLines(1) & vbcrlf ' TJS 23/06/19 ' end of code moved and amended TJS 23/06/19%> <%objConnTransact.BeginTrans bActivityRecordCreated = false TimeStamp = Now() for iRowLoop = 2 to iImportLineCount RowErrorMessage = "" ' TJS 23/06/19 bEarningsChanged = false ' TJS 29/04/18 ParseLine sImportLines(iRowLoop), sValueList, iValueCount ' TJS 24/12/22 for iValueLoop = 0 to iValueCount ' remove any spaces at start of field do while left(sValueList(iValueLoop), 1) = " " sValueList(iValueLoop) = mid(sValueList(iValueLoop), 2) loop ' remove any spaces at end of field do while right(sValueList(iValueLoop), 1) = " " sValueList(iValueLoop) = left(sValueList(iValueLoop), len(sValueList(iValueLoop)) - 1) loop ' remove starting and ending " if present if left(sValueList(iValueLoop), 1) = """" then sValueList(iValueLoop) = mid(sValueList(iValueLoop), 2) end if if right(sValueList(iValueLoop), 1) = """" then sValueList(iValueLoop) = left(sValueList(iValueLoop), len(sValueList(iValueLoop)) - 1) end if sValueList(iValueLoop) = replace(sValueList(iValueLoop), "%22", """") sValueList(iValueLoop) = replace(sValueList(iValueLoop), "%2C", ",") next if iValueCount = iFieldCount then if sValueList(0) <> "" then on error resume next EmployeeID = DecryptData(Trim(sValueList(0))) ' TJS 27/07/19 if err.number <> 0 then on error goto 0 AddToRowErrorMsg "Employee ID value is corrupted." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if on error goto 0 else EmployeeID = "" end if sql = "SELECT Employee_ID, Exclude_this_period FROM " & DBSchema & "Employees WHERE Employer_ID = " & EmployerID & " AND Payroll_ID = " ' TJS 24/12/22 sql = sql & PayrollID & " AND Deleted = 0 AND Transfered_To_Payroll = -1 " ' TJS 16/04/18 if EmployeeID <> "" then ' DC 22/04/15 sql = sql & " AND Employee_ID = " & EmployeeID end if if sValueList(1) <> "" then ' DC 22/04/15 sql = sql & " AND Title = '" & EncryptDataForDB(RemoveHTML(Trim(sValueList(1)))) & "'" ' TJS 27/07/19 end if if sValueList(2) = "" then AddToRowErrorMsg "Employee First name cannot be blank." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 else sql = sql & " AND Fore_Name_1 = '" & EncryptDataForDB(replace(RemoveHTML(Trim(sValueList(2))), "'", "'")) & "'" ' TJS 27/07/19 end if if sValueList(3) = "" then AddToRowErrorMsg "Employee Surname cannot be blank." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 else sql = sql & " AND Last_Name = '" & EncryptDataForDB(replace(RemoveHTML(Trim(sValueList(3))), "'", "'")) & "'" ' TJS 27/07/19 end if if sValueList(4) = "" then AddToRowErrorMsg "Employee Payroll Ref cannot be blank." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 else sql = sql & " AND Payroll_Ref = '" & EncryptDataForDB(RemoveHTML(Trim(sValueList(4)))) & "'" ' TJS 27/07/19 end if if sValueList(5) <> "" then ' DC 22/04/15 sql = sql & " AND NI_Number = '" & EncryptDataForDB(RemoveHTML(Trim(sValueList(5)))) & "'" ' TJS 27/07/19 end if set rsCheckEmployee = OpenRecordset(objConn, sql) if not rsCheckEmployee.EOF then ' start of code moved and amended TJS 24/12/22 if not cBool(rsEmployer("Exclude_Zero_Pay_Employees")) and cBool(rsCheckEmployee("Exclude_this_period")) then RowErrorMessage = "Employee is excluded from payroll run and Automatically exclude Employees with Zero Earnings is not enabled for this Payroll - cannot import Earnings." bImportError = true else ' end of code moved and amended TJS 24/12/22 for iValueLoop = 7 to iValueCount step 3 if sFieldList(iValueLoop) <> "" then sql = "SELECT Pay_Type_ID, Quantity_this_Period, Rate_this_Period, Quantity_next_Period, Rate_next_Period FROM " & DBSchema sql = sql & "Employee_Pay_Items WHERE Employer_ID = " & EmployerID & " AND Payroll_ID = " & PayrollID & " AND Deleted = 0 " sql = sql & "AND Employee_ID = " & rsCheckEmployee("Employee_ID") ' start of code added TJS 06/04/20 strPayItemName = UndoSpecialChars(mid(RemoveHTML(sFieldList(iValueLoop)), 5)) if instr(strPayItemName, "&") > 0 then sql = sql & " AND (Display_Name = '" & strPayItemName & "' OR Display_Name = '" & replace(strPayItemName, "&", "&") sql = sql & "' OR Display_Name = '" & replace(strPayItemName, "&", "&") & "')" else ' end of code added TJS 06/04/20 sql = sql & " AND Display_Name = '" & strPayItemName & "'" end if if Left(sFieldList(iValueLoop), 4) = "E - " then sql = sql & " AND Earning_or_Deduction = 'E'" elseif Left(sFieldList(iValueLoop), 4) = "D - " then sql = sql & " AND Earning_or_Deduction = 'D'" end if set rsCheckPayItem = OpenRecordset(objConn, sql) if not rsCheckPayItem.EOF then ' ignore blank Qty values UpdateSQL = "" if sValueList(iValueLoop) <> "" then for iCharLoop = 1 to len(sValueList(iValueLoop)) ' check character is numeric or "." AscValue = asc(mid(sValueList(iValueLoop), iCharLoop, 1)) if ((AscValue < asc("0") or AscValue > asc("9")) and AscValue > asc(".")) or sValueList(iValueLoop) = "-" then ' DC 02/03/16 AddToRowErrorMsg "Invalid Qty value in column " & GetExcelColumnLetter(iValueLoop + 1) & " for Employee." ' DC 02/03/16 TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if next if not bImportError then ' TJS 23/06/19 if cDbl(rsCheckPayItem("Quantity_this_Period")) <> cDbl(sValueList(iValueLoop)) then if UpdateSQL <> "" then UpdateSQL = UpdateSQL & ", " end if UpdateSQL = UpdateSQL & "Quantity_this_Period = " & sValueList(iValueLoop) end if if CarryForward = "Yes" then if cDbl(rsCheckPayItem("Quantity_next_Period")) <> cDbl(sValueList(iValueLoop)) then if UpdateSQL <> "" then UpdateSQL = UpdateSQL & ", " end if UpdateSQL = UpdateSQL & "Quantity_next_Period = " & sValueList(iValueLoop) end if end if end if end if ' ignore blank Rate values if sValueList(iValueLoop + 1) <> "" then for iCharLoop = 1 to len(sValueList(iValueLoop + 1)) ' check character is numeric or "." AscValue = asc(mid(sValueList(iValueLoop + 1), iCharLoop, 1)) if ((AscValue < asc("0") or AscValue > asc("9")) and AscValue > asc(".")) or sValueList(iValueLoop + 1) = "-" then ' DC 02/03/16 AddToRowErrorMsg "Invalid Rate value in column " & GetExcelColumnLetter(iValueLoop + 2) & " for Employee." ' DC 02/03/16 TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if next if not bImportError then ' TJS 23/06/19 if cDbl(rsCheckPayItem("Rate_this_Period")) <> cDbl(sValueList(iValueLoop + 1)) then if UpdateSQL <> "" then UpdateSQL = UpdateSQL & ", " end if UpdateSQL = UpdateSQL & "Rate_this_Period = " & sValueList(iValueLoop + 1) end if if CarryForward = "Yes" then if cDbl(rsCheckPayItem("Rate_next_Period")) <> cDbl(sValueList(iValueLoop + 1)) then if UpdateSQL <> "" then UpdateSQL = UpdateSQL & ", " end if UpdateSQL = UpdateSQL & "Rate_next_Period = " & sValueList(iValueLoop + 1) end if end if end if end if ' check separator column is empty if iValueLoop + 2 <= iValueCount then if sValueList(iValueLoop + 2) <> "" then AddToRowErrorMsg "Column " & GetExcelColumnLetter(iValueLoop + 2) & " for Employee should be empty, but contains a value (" & sValueList(iValueLoop + 2) & ")." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if end if if UpdateSQL <> "" and not bImportError then ' TJS 23/06/19 sql = "UPDATE " & DBSchema & "Employee_Pay_Items SET " & UpdateSQL & " WHERE Employer_ID = " & EmployerID sql = sql & " AND Payroll_ID = " & PayrollID & " AND Deleted = 0 AND Employee_ID = " & rsCheckEmployee("Employee_ID") sql = sql & " AND Pay_Type_ID = " & rsCheckPayItem("Pay_Type_ID") ExecuteSQL objConnTransact, sql bEarningsChanged = true ' TJS 29/04/18 if not bActivityRecordCreated then sql = "INSERT INTO " & DBSchema & "Activity_Log (User_ID, Employer_ID, Activity, Time_Stamp) VALUES (" sql = sql & GetSessionVar("UserID") & ", " & EmployerID & ", 'Upd EPI', " & DBFormatDateTime(TimeStamp, True) & ")" ExecuteSQL objConnTransact, sql sql = "SELECT Activity_ID FROM " & DBSchema & "Activity_Log WHERE User_ID = " & GetSessionVar("UserID") sql = sql & " AND Activity = 'Upd EPI' AND Time_Stamp = " & DBFormatDateTime(TimeStamp, True) set rsActivityID = OpenRecordset(objConnTransact, sql) ActivityLogID = rsActivityID("Activity_ID") rsActivityID.close set rsActivityID = nothing ' start of code added TJS 29/04/18 sql = "INSERT INTO " & DBSchema & "Activity_Notes (Activity_ID, Table_Updated, Row_Updated, Notes) " sql = sql & "VALUES (" & ActivityLogID & ", 'Employee_Pay_Items', -1, 'Earnings data imported')" ExecuteSQL objConnTransact, sql ' end of code added TJS 29/04/18 bActivityRecordCreated = true end if if CarryForward = "Yes" then sql = "INSERT INTO " & DBSchema & "Activity_Notes (Activity_ID, Table_Updated, Row_Updated, Notes) " sql = sql & "VALUES (" & ActivityLogID & ", 'Employee_Pay_Items', " & rsCheckPayItem("Pay_Type_ID") sql = sql & ", 'Changes updated both Current and Future Periods (" & UpdateSQL & ")')" ExecuteSQL objConnTransact, sql else sql = "INSERT INTO " & DBSchema & "Activity_Notes (Activity_ID, Table_Updated, Row_Updated, Notes) " sql = sql & "VALUES (" & ActivityLogID & ", 'Employee_Pay_Items', " & rsCheckPayItem("Pay_Type_ID") sql = sql & ", 'Changes updated only Current Periods (" & UpdateSQL & ")')" ExecuteSQL objConnTransact, sql end if end if rsCheckPayItem.close elseif sValueList(iValueLoop) <> "" or sValueList(iValueLoop + 1) <> "" then AddToRowErrorMsg "Pay Item Name in column " & GetExcelColumnLetter(iValueLoop + 1) & " (" & strPayItemName & ") not found for Employee. " ' TJS 23/06/19 TJS 06/04/20 TJS 30/05/20 bImportError = true ' TJS 23/06/19 rsCheckPayItem.close end if else AddToRowErrorMsg "No Pay Item Name found in Row 1, Column " & GetExcelColumnLetter(iValueLoop + 1) & " but value is present for Employee.", ResponseMessage ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if next end if ' start of code added TJS 29/04/18 if cBool(rsEmployer("Exclude_Zero_Pay_Employees")) and bEarningsChanged and not bImportError then ' TJS 23/06/19 ' Automatically exclude Employees with Zero Earnings is active, does employee have zero earnings ? sql = "SELECT IFNULL(SUM(Quantity_this_Period * Rate_this_Period), 0) AS TotalEarnings FROM " & DBSchema & "Employee_Pay_Items WHERE Employee_ID = " sql = sql & rsCheckEmployee("Employee_ID") & " AND Employer_ID = " & EmployerID & " AND Payroll_ID = " & PayrollID & " AND Earning_or_Deduction = 'E' " ' TJS 15/09/18 sql = sql & "AND Deleted = 0 AND Pension_Item = 0" set rsTotalEarnings = OpenRecordset(objConnTransact, sql) if cDbl(rsTotalEarnings("TotalEarnings")) < 0.001 and cDbl(rsTotalEarnings("TotalEarnings")) > -0.001 then ' yes, exclude Employee sql = "UPDATE " & DBSchema & "Employees SET Exclude_this_period = -1 WHERE Employee_ID = " else ' no, include Employee sql = "UPDATE " & DBSchema & "Employees SET Exclude_this_period = 0 WHERE Employee_ID = " end if sql = sql & rsCheckEmployee("Employee_ID") & " AND Employer_ID = " & EmployerID & " AND Payroll_ID = " & PayrollID ExecuteSQL objConnTransact, sql sql = "INSERT INTO " & DBSchema & "Activity_Notes (Activity_ID, Table_Updated, Row_Updated, Notes) " sql = sql & "VALUES (" & ActivityLogID & ", 'Employee', " & rsCheckEmployee("Employee_ID") if cDbl(rsTotalEarnings("TotalEarnings")) < 0.001 and cDbl(rsTotalEarnings("TotalEarnings")) > -0.001 then sql = sql & ", 'Exclude_this_period set to -1')" else sql = sql & ", 'Exclude_this_period set to 0')" end if ExecuteSQL objConnTransact, sql end if ' end of code added TJS 29/04/18 else RowErrorMessage = "Data in ID columns (columns 1 to 6) does not match any Employee in Payroll." ' TJS 23/06/19 if cBool(GetSessionVar("AllowDebug")) then ' TJS 24/12/22 RowErrorMessage = RowErrorMessage & sql ' TJS 24/12/22 end if bImportError = true ' TJS 23/06/19 end if elseif iValueCount > 0 then RowErrorMessage = "Row column count (" & iValueCount & ") does not match header field count (" & iFieldCount & ")." ' TJS 23/06/19 bImportError = true ' TJS 23/06/19 end if ' start of code added TJS 23/06/19 ErrorsFile = ErrorsFile & sImportLines(iRowLoop) if RowErrorMessage <> "" then ErrorsFile = ErrorsFile & ",""" & RowErrorMessage & """" end if ErrorsFile = ErrorsFile & vbcrlf ' end of code added TJS 23/06/19 next ' did any processing errors occur ? if not bImportError then ' TJS 23/06/19 ' no ' start of code added TJS 30/05/20 sql = "UPDATE " & DBSchema & "Payrolls SET Input_Data_Changed = CURRENT_TIMESTAMP WHERE Employer_ID = " & EmployerID & " AND Payroll_ID = " & PayrollID ExecuteSQL objConnTransact, sql ' end of code added TJS 30/05/20 objConnTransact.CommitTrans ResponseMessage = "Import completed successfully" FileURL = "" ' TJS 23/06/19 bImportSuccessful = true ' TJS 10/09/21 else objConnTransact.RollbackTrans ' start of code added TJS 23/06/19 ResponseMessage = "Import aborted due to errors - see error file for details" SaveErrorsFile ' end of code added TJS 23/06/19 end if objConnTransact.close set objConnTransact = nothing ' start of code added TJS 23/06/19 else ErrorsFile = ErrorsFile & sImportLines(1) & ",""" & RowErrorMessage & """" & vbcrlf CompleteErrorsFile 2, "" end if else ResponseMessage = "" if sQtyRateList(0) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(1) & " must be blank" end if if sQtyRateList(1) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(2) & " must be blank" end if if sQtyRateList(2) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(3) & " must be blank" end if if sQtyRateList(3) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(4) & " must be blank" end if if sQtyRateList(4) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(5) & " must be blank" end if if sQtyRateList(5) <> "" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(6) & " must be blank" end if ResponseMessage = "Error in Row 2 header" & ResponseMessage CompleteErrorsFile 3, ResponseMessage end if ' end of code added TJS 23/06/19 rsEmployer.close ' TJS 16/04/18 set rsEmployer = nothing ' TJS 16/04/18 ' start of code added TJS 23/06/19 else ErrorsFile = ErrorsFile & sImportLines(0) & ",""" & RowErrorMessage & """" & vbcrlf CompleteErrorsFile 1, "" end if ' end of code added TJS 23/06/19 else ' start of code added TJS 17/06/19 ResponseMessage = "" if sFieldList(0) <> "Employee ID" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(1) & " must be Employee ID" end if if sFieldList(1) <> "Employee Title" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(2) & " must be Employee Title" end if if sFieldList(2) <> "Employee First Name" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(3) & " must be Employee First Name" end if if sFieldList(3) <> "Employee Surname" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(4) & " must be Employee Surname" end if if sFieldList(4) <> "Payroll Ref" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(5) & "must be Payroll Ref" end if if sFieldList(5) <> "NI Number" then if ResponseMessage = "" then ResponseMessage = ResponseMessage & " - " else ResponseMessage = ResponseMessage & ", " end if ResponseMessage = ResponseMessage & "Column " & GetExcelColumnLetter(6) & " must be NI Number" end if ' end of code added TJS 17/06/19 ResponseMessage = "One or more Employee identification fields missing from file header - " & ResponseMessage ' TJS 17/06/19 TJS 23/06/19 CompleteErrorsFile 2, ResponseMessage ' TJS 23/06/19%> <%end if else ResponseMessage = "Row 2 (Quantity / Rate) field count (" & iQtyRateCount & ") does not match header field count (" & iFieldCount & ")." & sImportLines(1) CompleteErrorsFile 2, ResponseMessage ' TJS 23/06/19%> <%end if else ResponseMessage = "File header must contain at least 1 Pay Item field in addition to the Employee identification fields." CompleteErrorsFile 1, ResponseMessage ' TJS 23/06/19%> <%end if else ' start of code added TJS 22/04/23 CRCount = UBound(Split(sFileData, vbCr)) LFCount = UBound(Split(sFileData, vbLf)) if CRCount > iImportLineCount and LFCount < CRCount then ResponseMessage = "File appears to have been created and saved with only Carriage Return characters to terminate each line
- each line MUST have both Carriage Return and Line Feed characters to terminate it" elseif LFCount > iImportLineCount and CRCount < LFCount then ResponseMessage = "File appears to have been created and saved with only Line Feed characters to terminate each line
- each line MUST have both Carriage Return and Line Feed characters to terminate it" else ' end of code added TJS 22/04/23 ResponseMessage = "File must contain a Header row, a Quantity / Rate row and at least 1 Employee data row. " end if CompleteErrorsFile 0, ResponseMessage ' TJS 23/06/19%> <%end if else ResponseMessage = "There was no file to upload."%> <%end if else ResponseMessage = "Not a valid file type " & uFiletype%> <%end if SaveSessionVarsRecord SessionVarsID ReleaseASPEncrypt objConn.close set objConn = nothing Set oPseudoRequest = Nothing%>