VERSION 5.00 Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmHourList Caption = "Daily Payroll for Hourly Employees" ClientHeight = 7080 ClientLeft = 60 ClientTop = 345 ClientWidth = 8295 ControlBox = 0 'False KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7080 ScaleWidth = 8295 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtCombOTHrs Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 6090 TabIndex = 60 Top = 5070 Width = 615 End Begin VB.TextBox txtCombRTHrs Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 5385 TabIndex = 58 Top = 5070 Width = 615 End Begin LpLib.fpList lstPayCrews Height = 3960 Left = 165 TabIndex = 57 Top = 720 Width = 3765 _Version = 196608 _ExtentX = 6641 _ExtentY = 6985 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = -2147483643 ForeColor = -2147483640 Columns = 10 Sorted = 1 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= 0 'False ColumnHeaderHeight= -1 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmHourList.frx":0000 End Begin VB.TextBox txtPC2 BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 2445 TabIndex = 54 Top = 6780 Width = 615 End Begin VB.TextBox txtPayCD Alignment = 2 'Center Height = 285 Left = 6330 TabIndex = 20 Top = 5835 Width = 570 End Begin VB.TextBox txtPC1 BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 1770 TabIndex = 53 Top = 6780 Width = 615 End Begin VB.TextBox txtOTRate2 Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 6735 TabIndex = 49 Top = 4515 Width = 615 End Begin VB.TextBox txtOT2 Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 6090 TabIndex = 48 Top = 4515 Width = 615 End Begin VB.TextBox txtRT2 Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 5355 TabIndex = 47 Top = 4515 Width = 615 End Begin VB.TextBox txtPayRate2 Alignment = 1 'Right Justify BackColor = &H8000000F& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 4725 TabIndex = 46 Top = 4515 Width = 615 End Begin VB.TextBox txtCMSCD2 Alignment = 2 'Center BackColor = &H8000000F& Height = 285 Left = 4110 TabIndex = 45 Top = 4515 Width = 570 End Begin VB.TextBox txtCMSCD1 Alignment = 2 'Center BackColor = &H8000000F& Height = 285 Left = 4110 TabIndex = 44 Top = 4785 Width = 570 End Begin VB.TextBox txtOTR Height = 285 Left = 3690 TabIndex = 38 Top = 60 Visible = 0 'False Width = 225 End Begin VB.TextBox txtWCCODE Height = 285 Left = 3300 TabIndex = 36 Top = 435 Visible = 0 'False Width = 240 End Begin VB.CommandButton cmdDelDaily Caption = "Delete Daily Information" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 1410 TabIndex = 35 Top = 6180 Width = 1170 End Begin VB.TextBox txtNotes Height = 825 Left = 4050 MultiLine = -1 'True TabIndex = 21 Top = 6165 Width = 4170 End Begin VB.CheckBox chkDeduct Caption = "Automatic Deductions" Height = 255 Left = 6240 TabIndex = 33 TabStop = 0 'False Top = 345 Visible = 0 'False Width = 2025 End Begin VB.CheckBox chkDone Caption = "Sent to CMS" Height = 210 Left = 6345 TabIndex = 32 TabStop = 0 'False Top = 5625 Width = 1680 End Begin VB.CheckBox chkReady Caption = "Ready to Process" Height = 255 Left = 6345 TabIndex = 31 TabStop = 0 'False Top = 5385 Width = 1650 End Begin VB.TextBox txtRate Height = 225 Left = 3345 TabIndex = 30 Top = 180 Visible = 0 'False Width = 195 End Begin VB.CommandButton cmdMAS90 Caption = "Setup Hrly for CMS" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 180 TabIndex = 29 Top = 6180 Width = 1170 End Begin VB.ListBox lstCrew Height = 2985 Left = 4005 Sorted = -1 'True TabIndex = 4 TabStop = 0 'False Top = 735 Visible = 0 'False Width = 4200 End Begin VB.ListBox lstHours Height = 3180 Left = 3990 Sorted = -1 'True TabIndex = 22 Top = 735 Width = 4215 End Begin VB.TextBox txtHrsWorked Alignment = 1 'Right Justify Height = 285 Left = 5145 TabIndex = 19 Top = 5850 Width = 1110 End Begin VB.CommandButton cmdAddDaily Caption = "Add Daily Information" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 1410 TabIndex = 18 Top = 5025 Width = 1170 End Begin VB.CommandButton cmdSave Caption = "Save Daily Information" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 1410 TabIndex = 23 Top = 5610 Width = 1170 End Begin MSComCtl2.DTPicker dtpWorkDate Height = 300 Left = 4950 TabIndex = 15 Top = 5475 Width = 1290 _ExtentX = 2275 _ExtentY = 529 _Version = 393216 Format = 94830593 CurrentDate = 43396 End Begin MSComCtl2.DTPicker dtpPayDate Height = 345 Left = 1155 TabIndex = 10 Top = 90 Width = 1335 _ExtentX = 2355 _ExtentY = 609 _Version = 393216 Format = 94830593 CurrentDate = 43396 End Begin VB.TextBox txtDept Height = 225 Left = 2610 TabIndex = 9 TabStop = 0 'False Top = 435 Visible = 0 'False Width = 330 End Begin VB.TextBox txtEmpName Height = 225 Left = 2580 TabIndex = 8 TabStop = 0 'False Top = -15 Visible = 0 'False Width = 540 End Begin VB.CommandButton cmdAddName Caption = "Add by Emp Last Name" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 180 TabIndex = 7 TabStop = 0 'False Top = 5610 Width = 1170 End Begin VB.CommandButton cmdExit Caption = "&Exit" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 2610 TabIndex = 3 Top = 5025 Width = 1170 End Begin VB.TextBox txtEmpId Height = 225 Left = 2580 TabIndex = 6 TabStop = 0 'False Top = 195 Visible = 0 'False Width = 585 End Begin VB.CommandButton cmdDelete Caption = "&Delete Employee" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 2610 TabIndex = 2 Top = 5610 Width = 1170 End Begin VB.CommandButton cmdAdd Caption = "&Add by Emp Number" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 180 TabIndex = 1 Top = 5025 Width = 1170 End Begin VB.Label txtTtlCD1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 7365 TabIndex = 62 Top = 4785 Width = 870 End Begin VB.Label txtTtlCD2 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 7365 TabIndex = 61 Top = 4515 Width = 870 End Begin VB.Label lblComb Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Combined" Height = 195 Left = 4560 TabIndex = 59 Top = 5145 Width = 705 End Begin VB.Label lblSlsh2 AutoSize = -1 'True Caption = "/" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 5985 TabIndex = 56 Top = 4485 Width = 90 End Begin VB.Label lblSlach AutoSize = -1 'True Caption = "/" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 5985 TabIndex = 55 Top = 4740 Width = 90 End Begin VB.Label lblVALIDCD AutoSize = -1 'True Caption = "Valid CMS Pay Codes: " Height = 195 Left = 135 TabIndex = 52 Top = 6825 Width = 1635 End Begin VB.Label lblCMSRTCD AutoSize = -1 'True Caption = "CMS Pay Code: " Height = 195 Left = 6930 TabIndex = 51 Top = 5880 Width = 1170 End Begin VB.Label lblCMS Alignment = 2 'Center AutoSize = -1 'True Caption = "CMS Cd" Height = 195 Left = 4080 TabIndex = 50 Top = 4275 Width = 600 End Begin VB.Label lblRTRate Caption = "R Rate" Height = 195 Left = 4740 TabIndex = 43 Top = 4275 Width = 585 End Begin VB.Label lblRTHrs Alignment = 1 'Right Justify Caption = "R Hrs" Height = 180 Left = 5370 TabIndex = 42 Top = 4275 Width = 555 End Begin VB.Label lblOTHrs Alignment = 1 'Right Justify Caption = "OT Hrs" Height = 195 Left = 6015 TabIndex = 41 Top = 4275 Width = 615 End Begin VB.Label lblOTRate AutoSize = -1 'True Caption = "OT Rate" Height = 195 Left = 6720 TabIndex = 40 Top = 4275 Width = 615 End Begin VB.Label lblTTL AutoSize = -1 'True Caption = "WK Total" Height = 195 Left = 7485 TabIndex = 39 Top = 4275 Width = 675 End Begin VB.Label txtOTRate Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 6735 TabIndex = 37 Top = 4785 Width = 615 End Begin VB.Label lblNotes Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Notes:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3480 TabIndex = 34 Top = 6690 Width = 570 End Begin VB.Label txtOT Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 6090 TabIndex = 28 Top = 4785 Width = 615 End Begin VB.Label txtTtlWage Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 7365 TabIndex = 27 Top = 5070 Width = 870 End Begin VB.Label txtRT Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 5370 TabIndex = 26 Top = 4785 Width = 615 End Begin VB.Label txtPayRate Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 4725 TabIndex = 25 Top = 4785 Width = 615 End Begin VB.Label lblTotal AutoSize = -1 'True Caption = "Pay Period Totals:" Height = 195 Left = 2745 TabIndex = 24 Top = 4755 Width = 1290 End Begin VB.Label lblHrsWrk AutoSize = -1 'True Caption = "Hours Worked:" Height = 195 Left = 4005 TabIndex = 17 Top = 5865 Width = 1080 End Begin VB.Label lblWorkDate AutoSize = -1 'True Caption = "Work Date:" Height = 195 Left = 4065 TabIndex = 16 Top = 5520 Width = 825 End Begin VB.Label lblDept BorderStyle = 1 'Fixed Single Height = 315 Left = 4035 TabIndex = 14 Top = 3945 Width = 585 End Begin VB.Label lblEmpName BorderStyle = 1 'Fixed Single Height = 315 Left = 5565 TabIndex = 13 Top = 3960 Width = 2655 End Begin VB.Label lblEmpId BorderStyle = 1 'Fixed Single Height = 315 Left = 4665 TabIndex = 12 Top = 3960 Width = 870 End Begin VB.Label lblPayDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Payroll Date:" Height = 195 Left = 195 TabIndex = 11 Top = 180 Width = 900 End Begin VB.Label lblCrewInstruct Caption = "Double Click or CTRL S on the desired Employee listed below to add the Employee to the Hourly List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 3960 TabIndex = 5 Top = 90 Visible = 0 'False Width = 3435 End Begin VB.Label lblCrew AutoSize = -1 'True Caption = "Hourly Employee List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 240 TabIndex = 0 Top = 540 Width = 1785 End End Attribute VB_Name = "frmHourList" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim mintBOOKMARK1 As Integer, mintBOOKMARK2 As Integer Dim moRSCREW As Recordset Dim moRSMember As Recordset Dim moRSHour As Recordset, moRSDaily As Recordset Dim mstrNUMCDS As String, msglGRS, msglTGS1, msglTGS2, msglTOHR As Single Dim msglTRHR As Single, msglOHR2, msglRHR2, msglOHR1, msglRHR1 As Single Dim mstrCCD2, mstrCCD1 As String, msgl1HR, msgl2HR, msglTHR As Single Dim msglORT2, msglRRT2, msglORT1, msglRRT1 As Single Dim mlngPCID2 As Long, mstrEMPID As String Dim msglRTHRS As Single, msglOTHRS As Single Dim mboolAdding As Boolean, mlngPCID As Long, mboolSHOW As Boolean Dim mlngDAYID As Long, mdblSUMHRS As Double, mdblGROSS As Double Private Sub FormClearHrs() dtpWorkDate.Value = dtpPayDate.Value ' dtpWorkDate.Value = Date txtHrsWorked = "" txtNotes = "" ' chkDeduct = vbUnchecked chkDone = vbUnchecked chkReady = vbUnchecked End Sub Private Sub FormClearEmp() lblDept = "" lblEmpId = "" lblEmpName = "" txtTtlWage = "" txtPayRate = "" txtOTRate = "" txtOT = "" txtRT = "" txtPayRate2 = "" txtOTRate2 = "" txtOT2 = "" txtRT2 = "" txtCombRTHrs = "" txtCombOTHrs = "" txtCMSCD1 = "" txtCMSCD2 = "" txtPC1 = "" txtPC2 = "" End Sub Private Sub UpPayRate() Dim strEMPID As String, strPAYDT As String Dim oRS As Recordset, strSQL As String, oRSS As Recordset, strSQLL As String lstPayCrews.col = 1 strEMPID = lstPayCrews.ColText strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strEMPID & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then strPAYDT = dtpPayDate.Value strSQLL = "SELECT EMP_ID, PAY_DATE, RATE, Reg_RT2, OT_Rate, OT_RT2 FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & strPAYDT & "#" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic If Not oRSS.EOF Then oRSS!Rate = Field2Str2(oRS!Rate) oRSS!Reg_RT2 = Field2Str2(oRS!RegRate2) oRSS!OT_Rate = Field2Str2(oRS!OTRate) oRSS!OT_RT2 = Field2Str2(oRS!OTRate2) oRSS.Update Exit Sub End If End If End Sub Private Sub GetMember() Dim strCREW As String, strName As String ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strName = Format(Field2Str(lstCrew.ItemData(lstCrew.ListIndex)), "0000000") strCREW = "SELECT * FROM PR1_EmployeeMaster where EmployeeNumber = '" & strName & "'" ' strCREW = "SELECT Department, employeenumber, firstname, lastname, Rate, Terminated FROM PR1_EmployeeMaster where EmployeeNumber = '" & strName & "'" ' strCREW = "SELECT Department, employeenumber, firstname, lastname, Terminated FROM PR1_EmployeeMaster where department = '52' and EmployeeNumber = '0004107'" '& strName & "'" Set moRSMember = New Recordset ' moRSMember.Open strCREW, goConn2, adOpenKeyset, adLockOptimistic moRSMember.Open strCREW, goConn, adOpenKeyset, adLockOptimistic If moRSMember!Terminated <> "A" Then MsgBox "This Employee is Terminated - Be Sure To Correct Before Entering Payroll", vbOKOnly, "Terminated Employee" End If If moRSMember.EOF Then MsgBox "Critial Error - No Crew Member Found - Call Darv", vbCritical + vbOKOnly, "Critical Error" Unload Me End If End Sub Private Sub cmdAdd_Click() Dim intID As Double, strSQL As String, strID As String Dim oRS As Recordset cmdAdd.Enabled = False cmdAddName.Enabled = False cmdDelete.Enabled = False cmdMAS90.Enabled = False cmdAddDaily.Enabled = False cmdSave.Enabled = False cmdDelDaily.Enabled = False 'Code to Add a Crew mboolAdding = True intID = Field2Double(InputBox("Enter The Employee Number To Add", "Employee Number", 9999)) If intID = 0 Then cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True cmdMAS90.Enabled = True cmdAddDaily.Enabled = True cmdSave.Enabled = True cmdDelDaily.Enabled = True cmdAdd.SetFocus Exit Sub End If If Len(intID) > 0 Then ' If Not gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strID = Format(intID, "0000000") strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strID & "'" ' strSQL = "SELECT Department, EmployeeNumber, LastName, DefaultWCCode, FirstName, PayRate1, Terminated FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strID & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic If oRS.EOF Then Call CrewLoad Else txtRate = Format(Field2Str2(oRS!Rate), "#,#.00") ' txtRate = "0" If txtRate > 50 Then MsgBox "This Employee Appears to be Salaried", vbOKOnly, "Salaried Employee" cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True cmdMAS90.Enabled = True cmdAddDaily.Enabled = True cmdSave.Enabled = True cmdDelDaily.Enabled = True cmdAdd.SetFocus Exit Sub End If txtEmpId = Field2Str(oRS!EmployeeNumber) txtDept = Field2Str(oRS!department) txtEmpName = Trim$(Field2Str(oRS!FirstName)) & " " & Trim$(Field2Str(oRS!LastName)) txtWCCode = Field2Str(oRS!wc_code) txtRate = Field2Str2(oRS!Rate) txtOTR = Field2Str2(oRS!OTRate) If oRS!Terminated <> "A" Then MsgBox "This Employee is Terminated - Be Sure To Correct Before Entering Payroll", vbOKOnly, "Terminated Employee" End If txtWCCode = Field2Str(oRS!wc_code) chkReady = vbUnchecked chkDone = vbUnchecked Call FormSaveEmp cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True cmdMAS90.Enabled = True cmdAddDaily.Enabled = True cmdSave.Enabled = False cmdDelDaily.Enabled = True cmdAdd.SetFocus End If End If End Sub Private Sub cmdAddDaily_Click() cmdAdd.Enabled = False cmdDelete.Enabled = False cmdAddDaily.Enabled = False cmdMAS90.Enabled = False cmdDelDaily.Enabled = False cmdAddName.Enabled = False cmdSave.Enabled = True lstHours.Enabled = False lstPayCrews.Enabled = False cmdMAS90.Enabled = False mboolAdding = True Call FormClearHrs End Sub Private Sub cmdAddName_Click() Dim strName As String, strSQL As String, strLine As String Dim strSql2 As String, strSQL3 As String Dim oRS As Recordset ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If cmdAdd.Enabled = False cmdAddName.Enabled = False cmdDelete.Enabled = False cmdAddDaily.Enabled = False cmdDelDaily.Enabled = False cmdSave.Enabled = False cmdMAS90.Enabled = False 'Code to Add a Crew mboolAdding = True strName = InputBox("Enter The Employee Last Name To Add", "Employee Last Name") If Len(strName) > 0 Then strName = "lastname LIKE '" & Trim$(UCase(strName)) & "*'" strSQL = "SELECT * FROM PR1_EmployeeMaster" ' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName, PayRate1, Terminated FROM PR1_EmployeeMaster" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic oRS.Filter = strName lstCrew.Clear Do Until oRS.EOF With lstCrew strLine = Trim$(Field2Str(oRS!FirstName)) & " " & Trim$(Field2Str(oRS!LastName)) .AddItem strLine .ItemData(.NewIndex) = oRS!EmployeeNumber End With oRS.MoveNext Loop lstHours.Visible = False lstCrew.Visible = True lblCrewInstruct.Visible = True Else cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True End If End Sub Private Sub FieldsSaveEmp() Dim strSQL As String, strSQLM As String Dim oRS As Recordset, oRSM As Recordset, strName As String On Error GoTo Error_EH ' strSQL = "SELECT * FROM tblHourList" ' WHERE Crew_Id = 1" ' Set oRS = New Recordset ' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strSQLM = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & txtEmpId & "'" Set oRSM = New Recordset oRSM.Open strSQLM, goConn, adOpenForwardOnly, adLockReadOnly strSQL = "SELECT * FROM tblHourList" ' WHERE Crew_Id = 1" Set moRSHour = New Recordset moRSHour.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If mboolAdding Then moRSHour.AddNew End If With moRSHour !Pay_Date = Field2Str(dtpPayDate.Value) !emp_dept = Field2Str(txtDept) !Emp_ID = Field2Str(txtEmpId) strName = Mid(Field2Str2(txtEmpName), 1, 30) !EmpName = strName ' !EmpName = Field2Str(txtEmpName) !Rate = Field2Str2(txtRate) !wc_code = Field2Str(txtWCCode) !OT_Rate = Field2Str2(txtOTR) !OT_RT2 = oRSM!OTRate2 !Reg_RT2 = oRSM!RegRate2 !RATECD1 = oRSM!RATECD1 !RATECD2 = oRSM!RATECD2 !ready = chkReady !done = chkDone ' If chkDeduct Then ' !autodeduct = "Y" ' End If End With moRSHour.Update Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" Resume Next End If gstrMODULE = "Form HourList - Module FieldsSaveEmp" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FieldsSaveHrs() Dim strSQL As String, lngPCID As Long Dim oRS As Recordset Dim intTEST As Integer On Error GoTo Error_EH lstPayCrews.col = 0 lngPCID = Field2Str2(lstPayCrews.ColText) intTEST = moRSDaily.State If mboolAdding Then moRSDaily.AddNew End If With moRSDaily !Date = Field2Str(dtpWorkDate.Value) !emp_no = Field2Str(lblEmpId) !hours = Field2Str2(txtHrsWorked) !notes = Field2Str(txtNotes) !pc_id = lngPCID !PAYCD = txtPayCD ' !pc_id = lstPayCrews.ItemData(lstPayCrews.ListIndex) End With moRSDaily.Update moRSHour!ready = chkReady moRSHour!done = chkDone moRSHour.Update Exit Sub Error_EH: ' If Err.Number = -2147467259 Then ' MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" ' Resume Next ' End If gstrMODULE = "Form HourList - Module FieldsSaveHrs" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormSaveEmp() Dim strName As String On Error GoTo Error_EH ' Store the controls to the recordset Call FieldsSaveEmp If mboolAdding Then mboolAdding = False End If Call PayLoad txtEmpId = "" txtDept = "" txtEmpName = "" txtRate = 0 txtWCCode = "" Exit Sub Error_EH: gstrMODULE = "Form HourList - Module FormSaveEmp" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormSaveHrs() Dim strName As String On Error GoTo Error_EH ' Store the controls to the recordset Call FieldsSaveHrs Call GetEmpHours Call SumHours ' moRSHour!hours = mdblSUMHRS ' moRSHour!GROSS = mdblGROSS ' If Field2Str2(moRSHour!hours) > 40 Then ' txtRT = "40.00" ' txtOT = Format((Field2Str2(moRSHour!hours) - 40), "#.00") ' Else ' txtRT = Format(Field2Str2(moRSHour!hours), "#.00") ' txtOT = ".00" ' End If ' moRSHour!Reg_HRS = Field2Str2(txtRT) ' moRSHour!OT_HRS = Field2Str2(txtOT) ' moRSHour.Update If mboolAdding Then mboolAdding = False End If Call PayLoad ' txtEmpId = "" ' txtDept = "" ' txtEmpName = "" ' txtRate = 0 Exit Sub Error_EH: gstrMODULE = "Form HourList - Module FormSaveHrs" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub PayLoad() Dim oRS As Recordset Dim strSQL As String, strCREW As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from tblHourList WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY emp_id" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstPayCrews.Clear Do Until oRS.EOF With lstPayCrews strLine = Field2Str(oRS!pc_id) & vbTab & Field2Str(oRS!Emp_ID) & vbTab & Field2Str(oRS!EmpName) strLine = strLine & vbTab & Field2Str(oRS!RATECD1) & vbTab & Field2Str(oRS!RATECD2) & vbTab strLine = strLine & Field2Str(oRS!Rate) & vbTab & Field2Str(oRS!Reg_RT2) & vbTab & Field2Str(oRS!OT_Rate) & vbTab strLine = strLine & Field2Str(oRS!OT_RT2) & vbTab & Field2Str(oRS!gross) .AddItem strLine ' .ItemData(.NewIndex) = oRS!pc_id End With oRS.MoveNext Loop oRS.Close If lstPayCrews.ListCount Then lstPayCrews.ListIndex = 0 Else lstPayCrews.ListIndex = -1 lstHours.Clear Call FormClearHrs Call FormClearEmp cmdDelete.Enabled = False End If Exit Sub Error_EH: gstrMODULE = "Form HourList - Module PayLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub HoursLoad() Dim oRS As Recordset Dim strSQL As String, strCREW As String Dim strLine As String On Error GoTo Error_EH ' strSQL = "SELECT * from tblHrDaily WHERE PC_ID = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) & " ORDER BY DATE" strSQL = "SELECT * from tblHrDaily WHERE PC_ID = " & mlngPCID & " ORDER BY DATE" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstHours.Clear Do Until oRS.EOF With lstHours strLine = Field2Str(oRS!Date) & vbTab & Format(Field2Str(oRS!hours), "#.00") & vbTab & oRS!PAYCD .AddItem strLine .ItemData(.NewIndex) = oRS!DAY_ID End With oRS.MoveNext Loop oRS.Close If lstHours.ListCount Then lstHours.ListIndex = 0 Else strSQL = "SELECT * FROM tblHRDaily" Set moRSDaily = New Recordset moRSDaily.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lstHours.ListIndex = -1 cmdDelete.Enabled = False End If Exit Sub Error_EH: gstrMODULE = "Form HourList - Module HoursLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdDelete_Click() Dim strSQL As String, strYN As String strYN = MsgBox("Are You Sure You Want To Delete This Crew Member?", vbCritical + vbYesNo, "Delete?") If strYN <> vbYes Then Exit Sub End If strSQL = "DELETE * FROM tblHRDaily where PC_ID = " & mlngPCID goConn.Execute strSQL strSQL = "DELETE * FROM tblhourlist where PC_id = " & mlngPCID '& "' and Pay_Date = #" & dtpPayDate & "#" goConn.Execute strSQL Call PayLoad End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSave_Click() If (txtPayCD = "" Or IsNull(txtPayCD)) Then If txtHrsWorked = "" Or txtHrsWorked = "0" Or IsNull(txtHrsWorked) Then Else MsgBox "CMS Pay Code Is Required", vbOKOnly, "Need Pay Code" txtPayCD.SetFocus Exit Sub End If End If mintBOOKMARK1 = lstPayCrews.ListIndex mintBOOKMARK2 = lstHours.ListIndex cmdAdd.Enabled = True cmdAddDaily.Enabled = True cmdDelete.Enabled = True lstPayCrews.Enabled = True cmdMAS90.Enabled = True lstHours.Enabled = True cmdSave.Enabled = False Call FormSaveHrs lstPayCrews.ListIndex = mintBOOKMARK1 lstHours.ListIndex = mintBOOKMARK2 End Sub Private Sub cmdDelDaily_Click() Dim strSQL As String strSQL = "DELETE * FROM tblHRDAILY WHERE DAY_ID = " & mlngDAYID goConn.Execute strSQL Call HoursLoad Call GetEmpHours Call SumHours moRSHour!hours = mdblSUMHRS moRSHour!gross = mdblGROSS If Field2Str2(moRSHour!hours) > 40 Then txtRT = "40.00" txtOT = Format((Field2Str2(moRSHour!hours) - 40), "#.00") Else txtRT = Format(Field2Str2(moRSHour!hours), "#.00") txtOT = ".00" End If moRSHour!reg_hrs = Field2Str2(txtRT) moRSHour!OT_Hrs = Field2Str2(txtOT) moRSHour.Update cmdDelDaily.Enabled = False cmdAddDaily.Enabled = True cmdSave.Enabled = False End Sub Private Sub dtpPayDate_Change() Call PayLoad End Sub Private Sub dtpPayDate_Click() Call PayLoad End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH Exit Sub Error_EH: gstrMODULE = "Form HourList - Module Form_Activate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown If Shift = 4 Then Exit Sub End If ShiftDown = (Shift And vbShiftMask) > 0 AltDown = (Shift And vbAltMask) > 0 CtrlDown = (Shift And vbCtrlMask) > 0 If KeyCode = vbKeyS Then ' Display key combinations. If CtrlDown Then Call lstCrew_DblClick ' Call CrewLoad ' Call cmdTotal_Click ' Call lstLots_DblClick End If Exit Sub End If If KeyCode = vbKeyU Then ' Update Pay Rates If CtrlDown Then Call UpPayRate End If Exit Sub End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub Form_Load() On Error GoTo Error_EH dtpPayDate = Date dtpWorkDate = Date ' frmHourList.Width = 4140 ' frmHourList.Width = 4725 ' Call GetCrew Call PayLoad Exit Sub Error_EH: gstrMODULE = "Form HourList - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFindEmp() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblHourList WHERE PC_ID = " & mlngPCID Set moRSHour = New Recordset moRSHour.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSHour.EOF Then FormFindEmp = False Else FormFindEmp = True '**** Load Module storage With moRSHour mlngPCID2 = Field2Str2(!pc_id) mstrEMPID = Field2Str(!Emp_ID) msglRRT1 = Field2Str2(!Rate) msglORT1 = Field2Str2(!OT_Rate) msglRRT2 = Field2Str2(!Reg_RT2) msglORT2 = Field2Str2(!OT_RT2) msglTHR = Field2Str2(!hours) mstrCCD1 = Field2Str2(!RATECD1) mstrCCD2 = Field2Str2(!RATECD2) msglRHR1 = Field2Str2(!reg_hrs) msglOHR1 = Field2Str2(!OT_Hrs) msglRHR2 = Field2Str2(!Reg_HRS2) msglOHR2 = Field2Str2(!OT_Hrs2) msglTRHR = Field2Str2(!RTHours) msglTRHR = Field2Str2(!OTHours) msglTGS1 = Field2Str2(!GROSS_CD1) msglTGS2 = Field2Str2(!GROSS_CD2) msglGRS = Field2Str2(!gross) mstrNUMCDS = Field2Str(!CODES) End With End If Exit Function Error_EH: gstrMODULE = "Form HourList - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindHrs() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblHrDaily WHERE DAY_ID = " & mlngDAYID Set moRSDaily = New Recordset moRSDaily.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSDaily.EOF Then FormFindHrs = False Else FormFindHrs = True ' mlngDAYID = moRSDaily!DAY_ID End If Exit Function Error_EH: gstrMODULE = "Form HourList - Module FormFindHrs" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub ClearEmp() lblDept = "" lblEmpId = "" lblEmpName = "" txtPayRate = 0 txtPayRate2 = 0 txtOTRate = 0 txtOTRate2 = 0 txtTtlWage = 0 txtPC1 = "" txtPC2 = "" txtCMSCD1 = "" txtCMSCD2 = "" txtRT = ".00" txtOT = ".00" txtRT2 = ".00" txtOT2 = ".00" txtCombRTHrs = 0 txtCombOTHrs = 0 txtTtlCD1 = "" txtTtlCD2 = "" chkReady = vbUnchecked chkDone = vbUnchecked End Sub Private Sub FormShowEmp() On Error GoTo Error_EH mboolSHOW = True With moRSHour lblDept = Field2Str(!emp_dept) lblEmpId = Field2Str(!Emp_ID) lblEmpName = Field2Str(!EmpName) txtPayRate = Format(Field2Str(!Rate), "#.00") txtPayRate2 = Format(Field2Str(!Reg_RT2), "#.00") txtOTRate = Format(Field2Str(!OT_Rate), "#.00") txtOTRate2 = Format(Field2Str(!OT_RT2), "#.00") ' If Field2Str2(!hours) > 40 Then ' txtRT = "40.00" ' txtOT = Format((Field2Str2(!hours) - 40), "#.00") ' Else ' txtRT = Format(Field2Str2(!hours), "#.00") ' txtOT = ".00" ' End If txtTtlWage = Format(Field2Str2(!gross), "#,#.00") txtPC1 = Field2Str(!RATECD1) If txtPC1 = "0" Then txtPC1 = "" End If txtCMSCD1 = Field2Str(!RATECD1) txtPC2 = Field2Str(!RATECD2) If txtPC2 = "0" Then txtPC2 = "" End If txtRT = Format(Field2Str2(!reg_hrs), "#,#.00") txtOT = Format(Field2Str2(!OT_Hrs), "#,#.00") If txtPC2 = "" Then txtCMSCD2 = "NONE" txtRT2 = ".00" txtOT2 = ".00" Else txtCMSCD2 = Field2Str(!RATECD2) txtRT2 = Format(Field2Str2(!Reg_HRS2), "#,#.00") txtOT2 = Format(Field2Str2(!OT_Hrs2), "#,#.00") End If ' If Len(txtPC1) >= 1 Then ' !Codes = 1 ' .Update If Len(txtPC1) >= 1 And Len(txtPC2) >= 1 Then !CODES = 2 .Update ElseIf Len(txtPC1) >= 1 Then !CODES = 1 .Update End If txtCombRTHrs = Format(Field2Str2(!RTHours), "#,#.00") txtCombOTHrs = Format(Field2Str2(!OTHours), "#,#.00") txtTtlCD1 = Format(Field2Str2(!GROSS_CD1), "#,#.00") txtTtlCD2 = Format(Field2Str2(!GROSS_CD2), "#,#.00") chkReady = Field2CheckBox(!ready) chkDone = Field2CheckBox(!done) ' If !autodeduct = "Y" Then ' chkDeduct = vbChecked ' Else ' chkDeduct = vbUnchecked ' End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form HourList - Module FormShowEmp" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShowHrs() Dim strRate_CD As String On Error GoTo Error_EH mboolSHOW = True With moRSDaily strRate_CD = Field2Str(!PAYCD) If strRate_CD = 1 Then txtHrsWorked = Format(Field2Str(!hours), "#.00") txtPayCD = strRate_CD ElseIf strRate_CD > 2 Then txtHrsWorked = Format(Field2Str(!hours), "#.00") txtPayCD = strRate_CD End If ' txtHrsWorked = Format(Field2Str(!hours), "#.00") dtpWorkDate.Value = Field2Str(!Date) txtNotes = Field2Str(!notes) End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form HourList - Module FormShowHrs" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim strSQL As String, strLine As String On Error GoTo Error_EH ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If lblCrewInstruct.Visible = True strSQL = "SELECT * FROM PR1_EmployeeMaster" ' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName FROM PR1_EmployeeMaster" '' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName FROM PR1_EmployeeMaster Order BY LastName" Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' moRSCREW.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic 'adOpenForwardOnly , adLockReadOnly lstCrew.Clear Do Until moRSCREW.EOF With lstCrew strLine = Trim$(Field2Str(moRSCREW!FirstName)) & " " & Trim$(Field2Str(moRSCREW!LastName)) .AddItem strLine .ItemData(.NewIndex) = moRSCREW!EmployeeNumber End With moRSCREW.MoveNext Loop ' moRSCrew.Close frmHourList.Width = 9150 frmHourList.SetFocus Exit Sub Error_EH: gstrMODULE = "Form HourList - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstCrew_DblClick() Call GetMember '******Need to modify PR1_EmployeeMaster to include Type of pay (Hourly or Salary) txtEmpId = Field2Str(moRSMember!EmployeeNumber) txtDept = Field2Str(moRSMember!department) txtEmpName = Trim$(Field2Str(moRSMember!FirstName)) & " " & Trim$(Field2Str(moRSMember!LastName)) txtRate = Format(Field2Str2(moRSMember!Rate), "#,#.00") txtWCCode = Field2Str(moRSMember!wc_code) txtOTR = Format(Field2Str2(moRSMember!OTRate), "#.00") If txtRate > 50 Then MsgBox "This Employee Appears to be Salaried", vbOKOnly, "Salaried Employee" cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True cmdAddDaily.Enabled = True cmdSave.Enabled = False cmdMAS90.Enabled = True lstCrew.Visible = False lstHours.Visible = True lblCrewInstruct.Visible = False Exit Sub End If ' frmHourList.Width = 4140 ' frmHourList.Width = 4725 cmdAdd.Enabled = True cmdAddName.Enabled = True cmdDelete.Enabled = True cmdAddDaily.Enabled = True cmdSave.Enabled = False cmdMAS90.Enabled = True lstCrew.Visible = False lstHours.Visible = True lblCrewInstruct.Visible = False Call FormSaveEmp End Sub Private Sub lstHours_Click() If lstHours.ListIndex > -1 Then mlngDAYID = lstHours.ItemData(lstHours.ListIndex) Else mlngDAYID = 0 End If If FormFindHrs() Then Call FormShowHrs ' Call HoursLoad End If End Sub Private Sub lstHours_DblClick() cmdSave.Enabled = True cmdDelDaily.Enabled = True cmdAddDaily.Enabled = False End Sub Private Sub lstPayCrews_Click() lstPayCrews.col = 0 If lstPayCrews.ListIndex > -1 Then mlngPCID = Field2Str2(lstPayCrews.ColText) Else mlngPCID = 0 End If If FormFindEmp() Then Call FormShowEmp Call HoursLoad End If End Sub Private Sub lstPayCrews_DblClick() cmdSave.Enabled = True cmdDelete.Enabled = True End Sub Private Sub txtHrsWorked_GotFocus() Call FieldSelect(txtHrsWorked) End Sub Private Sub txtNotes_GotFocus() Call FieldSelect(txtNotes) End Sub Private Sub txtNotes_LostFocus() txtNotes = UCase(txtNotes) End Sub Private Sub GetEmpHours() Dim a End Sub Private Sub SumHours() Dim oRSH As Recordset, strSQLH As String ', oRSHL As Recordset, strSQLHL As String Dim oRS As Recordset, oRSS As Recordset, dblRT As Double, dblOTRATE As Double Dim strSQL As String, dblOT As Double, dblRTHours As Double Dim dblRT2 As Double, dblOT2 As Double, dblOTRATE2 As Double, dblREGRATE2 As Double Dim dblHOURS1 As Double, dblHOURS2 As Double, dblOTHours As Double On Error GoTo Error_EH strSQL = "SELECT SUM(Hours) as SUMHRS FROM tblHRDaily WHERE PC_ID = " & mlngPCID ' strSQL = "SELECT SUMHRS as SUM(Hours) FROM tblHRDaily where PC_ID = " & mlngPCID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then mdblSUMHRS = Field2Str2(oRS!SUMHRS) Else mdblSUMHRS = 0 End If strSQL = "SELECT SUM(Hours) as SUMHRS1 FROM tblHRDaily WHERE PAYCD = 1 and PC_ID = " & mlngPCID Set oRSS = New Recordset oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSS.EOF Then dblHOURS1 = Field2Str2(oRSS!SUMHRS1) Else dblHOURS1 = 0 End If strSQL = "SELECT SUM(Hours) as SUMHRS2 FROM tblHRDaily WHERE PAYCD > 1 and PC_ID = " & mlngPCID Set oRSH = New Recordset oRSH.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSH.EOF Then dblHOURS2 = Field2Str2(oRSH!sumhrs2) Else dblHOURS2 = 0 End If If mstrNUMCDS = 1 Then If mdblSUMHRS <= 40 Then moRSHour!OTHours = 0 moRSHour!OT_Hrs = 0 moRSHour!OT_Hrs2 = 0 moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = Field2Str2(oRS!SUMHRS) moRSHour!reg_hrs = Field2Str2(oRSS!SUMHRS1) moRSHour!Reg_HRS2 = 0 ' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2) moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate) moRSHour!GROSS_CD2 = 0 ' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2)) ' moRSHour!gross = Field2Single(moRSHour!GROSS_CD1) + Field2Single(moRSHour!GROSS_CD2) ' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2) moRSHour.Update ' Exit Sub ElseIf mdblSUMHRS > 40 Then moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = 40 moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40 dblOTHours = Field2Str2(oRS!SUMHRS) - 40 moRSHour!reg_hrs = 40 moRSHour!OT_Hrs = dblOTHours moRSHour!Reg_HRS2 = 0 moRSHour!OT_Hrs2 = 0 moRSHour!GROSS_CD1 = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1) ' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate)) moRSHour!GROSS_CD2 = 0 moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1) moRSHour.Update ''' If dblHOURS2 > dblOTHours Then ''' moRSHour!Reg_HRS2 = dblHOURS2 ''' moRSHour!OT_HRS = dblOTHours ''' moRSHour!Reg_HRS = dblHOURS1 - dblOTHours End If ElseIf mstrNUMCDS = 2 Then If dblHOURS1 > 0 And dblHOURS2 = 0 Then If mdblSUMHRS <= 40 Then moRSHour!OTHours = 0 moRSHour!OT_Hrs = 0 moRSHour!OT_Hrs2 = 0 moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = Field2Str2(oRS!SUMHRS) moRSHour!reg_hrs = CSng(Field2Str2(oRSS!SUMHRS1)) moRSHour!Reg_HRS2 = 0 ' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2) moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate) moRSHour!GROSS_CD2 = 0 ' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2)) ' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2) moRSHour.Update ' Exit Sub ElseIf mdblSUMHRS > 40 Then moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = 40 moRSHour!reg_hrs = 40 txtRT = 40 moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40 dblOTHours = Field2Str2(oRS!SUMHRS) - 40 moRSHour!OT_Hrs = dblOTHours moRSHour!Reg_HRS2 = 0 moRSHour!OT_Hrs2 = 0 moRSHour!GROSS_CD1 = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1) ' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate)) moRSHour!GROSS_CD2 = 0 moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1) moRSHour.Update End If ElseIf dblHOURS1 = 0 And dblHOURS2 > 0 Then If mdblSUMHRS <= 40 Then moRSHour!OTHours = 0 moRSHour!OT_Hrs = 0 moRSHour!OT_Hrs2 = 0 moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = Field2Str2(oRS!SUMHRS) moRSHour!Reg_HRS2 = Field2Str2(oRSH!sumhrs2) ' moRSHour!Reg_HRS2 = Field2Str2(oRSS!SUMHRS1) moRSHour!reg_hrs = 0 ' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2) moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!GROSS_CD1 = 0 ' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2)) ' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2) moRSHour.Update ' Exit Sub ElseIf mdblSUMHRS > 40 Then moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = 40 moRSHour!Reg_HRS2 = 40 txtRT2 = 40 moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40 dblOTHours = Field2Str2(oRS!SUMHRS) - 40 moRSHour!OT_Hrs2 = dblOTHours moRSHour!reg_hrs = 0 moRSHour!OT_Hrs = 0 moRSHour!GROSS_CD2 = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2) ' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate)) moRSHour!GROSS_CD1 = 0 moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2) moRSHour.Update End If ' End If ElseIf dblHOURS1 > 0 And dblHOURS2 > 0 Then If mdblSUMHRS <= 40 Then moRSHour!OTHours = 0 moRSHour!OT_Hrs = 0 moRSHour!OT_Hrs2 = 0 moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = dblHOURS1 + dblHOURS2 moRSHour!Reg_HRS2 = Field2Str2(oRSH!sumhrs2) ' moRSHour!Reg_HRS2 = Field2Str2(oRSS!SUMHRS1) moRSHour!reg_hrs = Field2Str2(oRSS!SUMHRS1) ' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2) moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate) ' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2)) ' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2) moRSHour.Update ' Exit Sub ElseIf mdblSUMHRS > 40 Then moRSHour!hours = Field2Str2(oRS!SUMHRS) moRSHour!RTHours = 40 moRSHour!OTHours = mdblSUMHRS - 40 ' - dblHOURS2 dblOTHours = Field2Str2(oRS!SUMHRS) - 40 moRSHour!reg_hrs = dblHOURS1 - (dblOTHours) ' moRSHour!Reg_HRS2 = dblHOURS2 - (mdblSUMHRS - 40) ' moRSHour!Reg_HRS2 = 40 ' txtRT2 = 40 ' moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40 moRSHour!OT_Hrs = dblOTHours moRSHour!Reg_HRS2 = dblHOURS2 moRSHour!OT_Hrs2 = 0 moRSHour!GROSS_CD2 = ((dblHOURS2 * msglRRT2)) + (Field2Str2(moRSHour!OT_Hrs2) * msglORT2) moRSHour!GROSS_CD1 = ((dblHOURS1 - dblOTHours) * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!OT_Rate)) ' moRSHour!Gross_CD1 = 0 ' moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2) moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2)) moRSHour.Update End If End If End If ''' moRSHour!Gross_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate) ''' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) ''' moRSHour!GROSS = Field2Single(moRSHour!Gross_CD1) + Field2Single(moRSHour!Gross_CD2) ''' moRSHour.Update ' Exit Sub ' moRSHour!Reg_HRS = "" ' dblRTHours '' If dblHOURS1 > dblOTHours Then '' moRSHour!OT_HRS = dblOTHours '' moRSHour!Reg_HRS = dblHOURS1 - dblOTHours ' moRSHour!Reg_HRS2 = dblHOURS1 - dblOTHours '' End If ' moRSHour!OT_HRS = 0 ' moRSHour!OT_HRS2 = 0 ' moRSHour!hours = Field2Str2(oRS!SUMHRS) ' moRSHour!RTHours = Field2Str2(oRS!SUMHRS) '' moRSHour!Reg_HRS = Field2Str2(oRSS!SUMHRS1) ' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2) '' moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate) '' moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2) '' moRSHour!GROSS = Field2Single(moRSHour!GROSS_CD1) + Field2Single(moRSHour!GROSS_CD2) ' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2) '' moRSHour.Update ' Else ''' dblRT = 40 * txtPayRate ''' dblOTRATE = (1.5 * txtPayRate) ''' dblOT = (mdblSUMHRS - 40) * dblOTRATE ''' mdblGROSS = Format((dblRT + dblOT), "#,#.00") ' End If ' End If Exit Sub Error_EH: ' If Err.Number = -2147467259 Then ' MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" ' Resume Next ' End If gstrMODULE = "Form HourList - Module SumHours" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdMAS90XX_Click() Dim strSQL As String, strSql2 As String, strSELECT As String Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset Dim dblOT As Double, dblOTRATE As Double, dblOTWAGE As Double Dim dblRT As Double, dblRTRATE As Double, dblRTWAGE As Double Screen.MousePointer = vbHourglass On Error GoTo Error_EH strSql2 = "DELETE * FROM tblPayroll" goConn.Execute strSql2 strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and ready" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblPayroll" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF ' strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id) ' Set oRT = New Recordset ' oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic ' Do Until oRT.EOF With oRS ' If !hours > 80 Then ' dblRT = 80 ' dblOT = !hours - 80 If !hours > 40 Then dblRT = 40 dblOT = !hours - 40 dblRTRATE = !Rate dblOTRATE = !Rate * 1.5 dblRTWAGE = Format(Round((dblRT * dblRTRATE), 2), "#,#.00") dblOTWAGE = Format(Round((dblOT * dblOTRATE), 2), "#,#.00") oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = dblRT oRSS!amount = dblRTWAGE oRSS!Rate = Field2Str(!Rate) If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS!earncode = "01" oRSS!wc_code = !wc_code oRSS.Update oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = dblOT oRSS!amount = dblOTWAGE oRSS!Rate = dblOTRATE If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS!earncode = "OT" oRSS.Update Else oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = Field2Str(!hours) oRSS!amount = Field2Str(!gross) oRSS!Rate = Field2Str(!Rate) If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS!earncode = "01" oRSS!wc_code = !wc_code oRSS.Update End If End With ' oRT.MoveNext ' Loop oRS!ready = vbUnchecked oRS!done = vbChecked oRS.Update oRS.MoveNext Loop Screen.MousePointer = vbDefault MsgBox "Payroll Is Ready To Be Imported Into MAS90" cmdExit.SetFocus Exit Sub Error_EH: gstrMODULE = "Form HourList - Module cmdPRProcess_Click" Call ErrorHandler2 gstrMODULE = "" Screen.MousePointer = vbDefault Exit Sub End Sub Private Sub cmdPRProcess2_Click() Dim strSQL As String, strSql2 As String, strSELECT As String Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset Screen.MousePointer = vbHourglass On Error GoTo Error_EH strSql2 = "DELETE * FROM tblPayroll" goConn.Execute strSql2 strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and p_flag" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblPayroll" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id) Set oRT = New Recordset oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF With oRT oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = Field2Str(!hours) oRSS!amount = Field2Str2(!gross) ' oRSS!amount = Field2Str2(!Reg_Wage) oRSS!Rate = Field2Str2(!Rate) oRSS!wc_code = Field2Str(!wc_code) oRSS!earncode = "1" ' oRSS!earncode = "11" oRSS!OT_Hours = Field2Str2(!OT_Hours) oRSS!OT_Amt = Field2Str2(!OT_Wage) oRSS!OT_TRANS = Field2Str2(!OT_Wage) / 1.5 oRSS!REG_TRANS = Field2Str2(!REG_WAGE) ' oRSS!earncode = "01" If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS.Update End With oRT.MoveNext Loop oRS!P_FLAG = vbUnchecked oRS.Update oRS.MoveNext Loop Screen.MousePointer = vbDefault MsgBox "Payroll Is Ready To Be Imported Into CMS - Click On 'Move PR To CMS' to Setup Transfer File" '' cmdMoveMAS90.SetFocus ' cmdExit.SetFocus Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPRProcess2_Click" Call ErrorHandler2 gstrMODULE = "" Screen.MousePointer = vbDefault Exit Sub End Sub Private Sub CMSPRTransfer() Dim strFile As String, strLINE1 As String, strLINE2 As String Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String Dim strREGWAGE, strOTWAGE, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String Dim strREGHOUR, strOTHOUR ', strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String Dim dblCHANGE As Double, lngDIF As Long, strMSG As String, strINV_DUE_Date As String, strDISC_Date As String Dim lngCount As Long, lngSALES As Long, lngPO As Long, strHR As String Dim strMONTH As String, strDAY As String, strSEC As String, strWCCODE As String Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String Dim strHEADER As String, strDETAIL As String, strLastInvNo As String Dim TStream As TextStream, strMIN As String, strDISC_PCT As String, strDISCYN As String strDAY = Format(Day(Date), "00") strMONTH = Format(Month(Date), "00") ' strMIN = Format(Minute(Date), "00") strMIN = Format(Minute(Now), "00") strHR = Format(Hour(Now), "00") strFile = "PREXT" & strMONTH & strDAY & strHR & strMIN strSQLLL = "SELECT * FROM tblPAYROLL ORDER BY EMPLOYEE_NO" Set oRSSS = New Recordset oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic strEXT = "G:\CMSTrans\" & strFile & ".csv" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)" ' strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)" Set FSys = New FileSystemObject Set TStream = FSys.CreateTextFile(strEXT, True) Do Until oRSSS.EOF strCUSTNo = oRSSS!employee_no strINVDATE = dtpPayDate.Value ' strTType = "1" ' strTType = "11" strTType = oRSSS!earncode strWCCODE = oRSSS!wc_code strREGWAGE = oRSSS!REG_TRANS ' strREGWAGE = oRSSS!amount strOTWAGE = oRSSS!OT_TRANS ' strOTWAGE = oRSSS!OT_Amt strREGHOUR = oRSSS!HOURS_WAGES ' strOTHOUR = "2" strOTHOUR = oRSSS!OT_Hours strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & strREGWAGE & "," & strOTWAGE & "," & "," & "," & "," & "," strHEADER = strHEADER & "," & "," ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab ' strHEADER = strCUSTNo & vbTab & strINVDATE & vbTab & strTType & vbTab & strWCCODE & vbTab & strREGWAGE & vbTab & strOTWAGE & vbTab & vbTab & vbTab & vbTab & vbTab ' strHEADER = strHEADER & vbTab & vbTab ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab TStream.WriteLine (strHEADER) ' strTType = "9" ' strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & "," & "," & "," & "," & "," & strREGHOUR & "," ' strHEADER = strHEADER & "," & "," & strOTHOUR ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab ' TStream.WriteLine (strHEADER) oRSSS.MoveNext Loop strMSG = "Export Complete - Go To CMS Payroll and IMPORT DAILY using an External File" ', vbInformation + vbOKOnly, "Export Complete") strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete" Close #1 cmdExit.SetFocus End Sub Private Sub txtPayCD_GotFocus() Call FieldSelect(txtPayCD) End Sub 'Private Sub cmdPRProcess_Click() Private Sub cmdMAS90_Click() Dim strSQL As String, strSql2 As String, strSELECT As String Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset Dim strCODE As String, intYN As Integer Screen.MousePointer = vbHourglass On Error GoTo Error_EH strSql2 = "DELETE * FROM tblPayroll" goConn.Execute strSql2 strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and READY" ' strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and p_flag" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblPayroll" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF ' strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id) ' Set oRT = New Recordset ' oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic ' Do Until oRT.EOF strCODE = Field2Str(oRS!CODES) With oRS ' oRSS.AddNew If strCODE = 1 Then oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = Field2Str(!reg_hrs) oRSS!amount = Field2Str2(!GROSS_CD1) ' oRSS!amount = Field2Str2(!Reg_Wage) oRSS!Rate = Field2Str2(!Rate) oRSS!wc_code = Field2Str(!wc_code) oRSS!earncode = Field2Str(!RATECD1) ' oRSS!earncode = "1" ' oRSS!earncode = "11" oRSS!OT_Hours = Field2Str2(!OT_Hrs) oRSS!OT_Amt = CSng(Field2Str2(!OT_Rate)) * CSng(Field2Str2(!OT_Hrs)) oRSS!OT_TRANS = Field2Str2(!OT_Hrs) oRSS!REG_TRANS = Field2Str(!reg_hrs) ' oRSS!earncode = "01" If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS.Update ElseIf strCODE = 2 Then If Field2Str2(oRS!GROSS_CD1) > 0 Then oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = Field2Str(!reg_hrs) oRSS!amount = Field2Str2(!GROSS_CD1) ' oRSS!amount = Field2Str2(!Reg_Wage) oRSS!Rate = Field2Str2(!Rate) oRSS!wc_code = Field2Str(!wc_code) oRSS!earncode = Field2Str(!RATECD1) ' oRSS!earncode = "1" ' oRSS!earncode = "11" oRSS!OT_Hours = Field2Str2(!OT_Hrs) oRSS!OT_Amt = CSng(Field2Str2(!OT_Rate)) * CSng(Field2Str2(!OT_Hrs)) oRSS!OT_TRANS = Field2Str2(!OT_Hrs) oRSS!REG_TRANS = Field2Str(!reg_hrs) ' oRSS!earncode = "01" If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS.Update End If If Field2Str2(oRS!GROSS_CD2) > 0 Then oRSS.AddNew oRSS!employee_no = Field2Str(!Emp_ID) oRSS!HOURS_WAGES = Field2Str(!Reg_HRS2) oRSS!amount = Field2Str2(!GROSS_CD2) ' oRSS!amount = Field2Str2(!Reg_Wage) oRSS!Rate = Field2Str2(!Reg_RT2) oRSS!wc_code = Field2Str(!wc_code) oRSS!earncode = Field2Str(!RATECD2) ' oRSS!earncode = "1" ' oRSS!earncode = "11" oRSS!OT_Hours = Field2Str2(!OT_Hrs2) oRSS!OT_Amt = CSng(Field2Str2(!OT_RT2)) * CSng(Field2Str2(!OT_Hrs)) oRSS!OT_TRANS = Field2Str2(!OT_Hrs2) oRSS!REG_TRANS = Field2Str(!Reg_HRS2) ' oRSS!earncode = "01" If Field2Str(!autodeduct) = "" Then oRSS!auto_deduction = "N" Else oRSS!auto_deduction = Field2Str(!autodeduct) End If oRSS.Update End If End If End With oRS!ready = vbUnchecked oRS!done = vbChecked oRS.Update oRS.MoveNext Loop ' oRS!P_FLAG = vbUnchecked ' oRS.Update ' oRS.MoveNext ' Loop Screen.MousePointer = vbDefault intYN = MsgBox("Payroll Is Ready To Be Imported Into CMS - Select YES to Setup Transfer File", vbYesNo, "Transfer Setup") If intYN = vbYes Then Call CMSPRTransfer ElseIf intYN = vbNo Then End If ' cmdMoveMAS90.SetFocus ' cmdExit.SetFocus Exit Sub Error_EH: gstrMODULE = "Form HourList - Module cmdPRProcess_Click" Call ErrorHandler2 gstrMODULE = "" Screen.MousePointer = vbDefault Exit Sub End Sub