VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "crystl32.ocx" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX" Begin VB.Form frmPayList Caption = "Payroll List" ClientHeight = 7995 ClientLeft = 60 ClientTop = 345 ClientWidth = 9030 ControlBox = 0 'False KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7995 ScaleWidth = 9030 StartUpPosition = 3 'Windows Default Begin VB.CommandButton cmdPrDetail Caption = "Print Pay Detail" 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 = 2400 TabIndex = 23 Top = 7380 Width = 1035 End Begin VB.CommandButton cmdUpEmpMaster Caption = "Up Emp Master" 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 = 1260 TabIndex = 22 Top = 7380 Width = 1035 End Begin VB.CommandButton cmdMoveMAS90 Caption = "Move PR to MAS90" 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 = 3540 TabIndex = 21 Top = 7380 Width = 1035 End Begin VB.CommandButton cmdPRProcess Caption = "Setup PR for MAS90" 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 = 120 TabIndex = 20 Top = 7380 Width = 1035 End Begin VB.CommandButton cmd1TimeSheet Caption = "1 Time Sheet" 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 = 2400 TabIndex = 19 TabStop = 0 'False Top = 6720 Width = 1035 End Begin VB.CommandButton cmdPrintPayLog Caption = "Payroll Log" 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 = 1260 TabIndex = 18 TabStop = 0 'False Top = 6720 Width = 1035 End Begin VB.CommandButton cmdPrint1Crew Caption = "1 Crew Summary" 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 = 3540 TabIndex = 17 TabStop = 0 'False Top = 6720 Width = 1035 End Begin VB.CommandButton cmdPrint1 Caption = "1 VWP Summary" 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 = 120 TabIndex = 16 TabStop = 0 'False Top = 6720 Width = 1035 End Begin VB.CommandButton cmdPrintTimeSheets Caption = "Time Sheets" 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 = 2400 TabIndex = 15 TabStop = 0 'False Top = 6060 Width = 1035 End Begin VB.CommandButton cmdPrintData Caption = "Data Input Sheet" 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 = 1260 TabIndex = 14 TabStop = 0 'False Top = 6060 Width = 1035 End Begin VB.CommandButton cmdPrintCrew Caption = "Print Crew Summary" 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 = 3540 TabIndex = 13 TabStop = 0 'False Top = 6060 Width = 1035 End Begin Crystal.CrystalReport crPay Left = 6900 Top = 5520 _ExtentX = 741 _ExtentY = 741 _Version = 348160 WindowState = 2 PrintFileLinesPerPage= 60 End Begin VB.CommandButton cmdPrint Caption = "Print VWP Summary" 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 = 120 TabIndex = 12 TabStop = 0 'False Top = 6060 Width = 1035 End Begin VB.CommandButton cmdAddMember Caption = "Add &Members" 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 = 1260 TabIndex = 5 TabStop = 0 'False Top = 5400 Width = 1035 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 = 2400 TabIndex = 6 TabStop = 0 'False Top = 5400 Width = 1035 End Begin VB.TextBox txtCrewID Height = 375 Left = 5160 TabIndex = 11 TabStop = 0 'False Top = 5580 Visible = 0 'False Width = 1215 End Begin VB.ListBox lstCrew Height = 3765 Left = 4680 Sorted = -1 'True TabIndex = 8 TabStop = 0 'False Top = 1560 Width = 4215 End Begin VB.CommandButton cmdDelete Caption = "&Delete Crew" 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 = 3540 TabIndex = 7 TabStop = 0 'False Top = 5400 Width = 1035 End Begin VB.CommandButton cmdAdd Caption = "&Add Crew" 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 = 120 TabIndex = 4 TabStop = 0 'False Top = 5400 Width = 1035 End Begin VB.ListBox lstPayCrews Height = 3765 Left = 120 TabIndex = 2 Top = 1560 Width = 4455 End Begin MSComCtl2.DTPicker dtpPayDate Height = 315 Left = 1320 TabIndex = 0 Top = 180 Width = 1215 _ExtentX = 2143 _ExtentY = 556 _Version = 393216 Format = 20250625 CurrentDate = 36942 MaxDate = 55153 MinDate = 36892 End Begin VB.Label lblCrewInstruct Caption = "Double Click or CTRL S on the desired crew listed below to add the crew to the current payroll 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 = 5340 TabIndex = 10 Top = 660 Width = 2955 End Begin VB.Label lblInstruct Caption = "Double Click or CTRL P on the desired crew to view payroll informaton for that crew for the payroll date shown." 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 = 9 Top = 600 Width = 4395 End Begin VB.Label lblCrew AutoSize = -1 'True Caption = "Crews for this payroll:" 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 = 180 TabIndex = 3 Top = 1320 Width = 1845 End Begin VB.Label lblPRDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Payroll Date:" Height = 195 Left = 360 TabIndex = 1 Top = 240 Width = 900 End End Attribute VB_Name = "frmPayList" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSPay As Recordset Dim moRSCREW As Recordset Dim mboolAdding As Boolean Private Sub cmd1TimeSheet_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 strSQL = "{tblcrew.crew_id} = " & Left$(lstPayCrews.Text, 3) crPAY.ReportFileName = App.Path & "\timesheet.rpt" crPAY.SelectionFormula = strSQL crPAY.Destination = crptToPrinter crPAY.CopiesToPrinter = 1 crPAY.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmd1TimeSheet_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAdd_Click() Dim intID As Integer, strSQL As String, lngINDEX As Long, lngFind As Long Dim oRS As Recordset On Error GoTo Error_EH cmdAdd.Enabled = False cmdDelete.Enabled = False 'Code to Add a Crew mboolAdding = True intID = InputBox("Enter The Crew Number To Add", "Crew Number", 999) If intID > 0 Then strSQL = "SELECT Crew_id, Crew_Boss, Type, Inactive FROM tblCREW WHERE crew_id = " & intID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then If oRS!inactive Then MsgBox "This Crew - " & oRS!crew_boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew" cmdAdd.Enabled = True Exit Sub End If End If If oRS.EOF Then Call CrewLoad Else txtCrewId = oRS!crew_id Call FormSave cmdAdd.Enabled = True If lstPayCrews.ListCount Then cmdDelete.Enabled = True End If cmdAdd.SetFocus End If Else cmdAdd.Enabled = True If lstPayCrews.ListCount Then cmdDelete.Enabled = True End If cmdAdd.SetFocus Exit Sub End If lngFind = Field2Long(intID) Call CBFindString2(lstPayCrews, Field2Str(intID)) ' lstPayCrews.SetFocus ' lngINDEX = ListFindItem(lstPayCrews, lngFind) ' Call ListFindItem3(lstPayCrews, lngFind) ' lstPayCrews.ListIndex = lngINDEX Exit Sub Error_EH: If Err.Number = 13 Then cmdAdd.Enabled = True If lstPayCrews.ListCount Then cmdDelete.Enabled = True End If Resume Next End If gstrMODULE = "Form PayList - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FieldsSave() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If mboolAdding Then oRS.AddNew oRS!C_USER = gstrLOGIN End If With oRS !U_USER = gstrLOGIN !Updated = Date !crew_id = txtCrewId !Pay_Date = dtpPayDate.Value End With oRS.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 PayList - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH ' Store the controls to the recordset Call FieldsSave ' moRSPay.Update If mboolAdding Then mboolAdding = False End If Call PayLoad Exit Sub Error_EH: ' Call ErrorHandler(moRSPay.ActiveConnection) gstrMODULE = "Form PayList - Module FieldsSave" 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 tblPayHeader WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY crew_id" Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstPayCrews.Clear Do Until moRSCREW.EOF With lstPayCrews strCREW = "SELECT * FROM tblCrew where CREW_id = " & moRSCREW!crew_id Set oRS = New Recordset oRS.Open strCREW, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then strLine = Field2Str(moRSCREW!crew_id) & " " & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!crew_boss) .AddItem strLine .ItemData(.NewIndex) = moRSCREW!pay_id End If End With moRSCREW.MoveNext Loop moRSCREW.Close If lstPayCrews.ListCount Then lstPayCrews.ListIndex = 0 cmdAddMember.Enabled = True cmdDelete.Enabled = True cmdPrint.Enabled = True cmdPrintCrew.Enabled = True cmdPrintData.Enabled = True cmdPrintTimeSheets.Enabled = True cmdPrint1.Enabled = True cmdPrint1Crew.Enabled = True cmdPrintPayLog.Enabled = True cmd1TimeSheet.Enabled = True cmdPRProcess.Enabled = True cmdUpEmpMaster.Enabled = True cmdMoveMAS90.Enabled = True cmdPrDetail.Enabled = True gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex) Else cmdAddMember.Enabled = False cmdDelete.Enabled = False cmdPrint.Enabled = False cmdPrintCrew.Enabled = False cmdPrintData.Enabled = False cmdPrintTimeSheets.Enabled = False cmdPrint1.Enabled = False cmdPrint1Crew.Enabled = False cmdPrintPayLog.Enabled = False cmd1TimeSheet.Enabled = False cmdPRProcess.Enabled = False cmdUpEmpMaster.Enabled = False cmdMoveMAS90.Enabled = False cmdPrDetail.Enabled = False ' Call ChangeButton End If Exit Sub Error_EH: gstrMODULE = "Form PayList - Module PayLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAddMember_Click() Dim intINDEX As Integer If lstPayCrews.ListIndex <> -1 Then intINDEX = lstPayCrews.ListIndex gintCREWID = Left$(Field2Str2(lstPayCrews.Text), 3) frmCrewList.Show 1 Call PayLoad lstPayCrews.ListIndex = intINDEX Else MsgBox "You Must Select A Crew", vbOKOnly, "Select Crew" Exit Sub End If End Sub Private Sub cmdDelete_Click() Dim strSQL As String, strYN As String strYN = MsgBox("Are You Sure You Want To Delete This Crew?", vbCritical + vbYesNo, "Delete?") If strYN <> vbYes Then Exit Sub End If strSQL = "DELETE * FROM tblTIME where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) goConn.Execute strSQL strSQL = "DELETE * FROM tblPayCrew where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) goConn.Execute strSQL strSQL = "DELETE * FROM tblPayHeader WHERE pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) goConn.Execute strSQL Call PayLoad End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdPrintVWP_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" Set oRS = New Recordset oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id) crPAY.ReportFileName = App.Path & "\payinfo.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrintVWP_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdMoveMAS90_Click() MsgBox "Go to MAS90 and Import the Payroll", vbOKOnly, "Goto MAS90" End Sub Private Sub cmdPrDetail_Click() Dim strDate As String, strSQL As String, intSUP As Integer Dim oRS As Recordset, intYN As Integer Dim strSELECT As String Dim strBegDate As String, strEndDate As String Dim intBYear As String, intBMonth As String, intBDay As String Dim intEYear As String, intEMonth As String, intEDay As String On Error GoTo Error_EH gboolPRINT = True intYN = MsgBox("Remember to Update Check Information Before Printing - Are You Ready?", vbYesNo, "Ready to Print") If intYN = vbNo Then Exit Sub End If intYN = MsgBox("Do You Want To Print to the Printer?", vbYesNo, "Window or Printer") If gboolPRINT Then strDate = dtpPayDate.Value intBYear = Mid(strDate, 7, 4) intBDay = Format(Mid(strDate, 4, 2), "00") intBMonth = Format(Mid(strDate, 1, 2), "00") ' intEYear = Mid(txtEndDate, 7, 4) ' intEDay = Format(Mid(txtEndDate, 4, 2), "00") ' intEMonth = Format(Mid(txtEndDate, 1, 2), "00") crPAY.ReportFileName = App.Path & "\PayDetail.rpt" crPAY.Formulas(3) = "ZZ_Date = Date(" & intBYear & "," & intBMonth & "," & intBDay & ")" ' crpay.Formulas(4) = "Z_Crew = " & mintCREW ' crpay.Formulas(5) = "Z_EndDate = Date(" & intEYear & "," & intEMonth & "," & intEDay & ")" If intYN = vbYes Then crPAY.Destination = crptToPrinter Else crPAY.Destination = crptToWindow End If crPAY.Action = 1 gboolPRINT = False End If Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrDetail_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrint_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" Set oRS = New Recordset oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id) crPAY.ReportFileName = App.Path & "\payinfo.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrint_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrint1_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 ' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" ' Set oRS = New Recordset ' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic ' oRS.MoveFirst ' Do Until oRS.EOF strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) crPAY.ReportFileName = App.Path & "\payinfo.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 ' oRS.MoveNext ' Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrint1_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrint1Crew_Click() Dim strSQL As String ', strSQL2 As String 'Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) crPAY.ReportFileName = App.Path & "\payinfo2.rpt" crPAY.SelectionFormula = strSQL crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrint1Crew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrintCrew_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" Set oRS = New Recordset oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id) crPAY.ReportFileName = App.Path & "\payinfo2.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrintCrew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrintData_Click() Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 intMonth = Month(dtpPayDate.Value) intDay = Day(dtpPayDate.Value) intYear = Year(dtpPayDate.Value) ' Do Until oRS.EOF strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")" crPAY.ReportFileName = App.Path & "\paylist.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 ' oRS.MoveNext ' Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrintData_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrintPayLog_Click() Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer On Error GoTo Error_EH gintPRINT = 1 frmReport.Show 1 intMonth = Month(dtpPayDate) intDay = Day(dtpPayDate) intYear = Year(dtpPayDate) ' Do Until oRS.EOF ' strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")" ' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" ' Set oRS = New Recordset ' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic ' oRS.MoveFirst ' Do Until oRS.EOF strSQL = "{tblpayheader.pay_Date} = Date(" & intYear & "," & intMonth & "," & intDay & ")" crPAY.ReportFileName = App.Path & "\paylog.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow ' crpay.Destination = crptToPrinter crPAY.Destination = gintDEST crPAY.CopiesToPrinter = gintCOPY crPAY.Action = 1 ' oRS.MoveNext ' Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrint_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrintTimeSheets_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset On Error GoTo Error_EH gintPRINT = 1 ' frmReport.Show 1 strSql2 = "SELECT crew_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id" Set oRS = New Recordset oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF strSQL = "{tblcrew.crew_id} = " & Field2Str2(oRS!crew_id) crPAY.ReportFileName = App.Path & "\timesheet.rpt" crPAY.SelectionFormula = strSQL ' crPay.Destination = crptToWindow crPAY.Destination = crptToPrinter ' crPay.Destination = gintDEST crPAY.CopiesToPrinter = 1 crPAY.Action = 1 oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPrintTimeSheet_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPRProcess_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 tblPayHeader 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 = Field2Str(!gross) oRSS!Rate = Field2Str(!Rate) oRSS!wc_code = Field2Str(!wc_code) 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 MAS90" cmdExit.SetFocus Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPRProcess_Click" Call ErrorHandler2 gstrMODULE = "" Screen.MousePointer = vbDefault Exit Sub End Sub Private Sub cmdUpEmpMaster_Click() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset Screen.MousePointer = vbHourglass On Error GoTo Error_EH If gboolMAS90 Then MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" Exit Sub End If strSql2 = "DELETE * FROM PR1_EmployeeMaster" goConn.Execute strSql2 strSql2 = "SELECT department, employeenumber, lastname, firstname, socialsecuritynumber, DefaultWCCode, employeestatus_AIT FROM PR1_EmployeeMaster" Set oRSS = New Recordset oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSS.EOF strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE employeenumber = '" & Field2Str(oRSS!employeenumber) & "' and department = '" & Field2Str(oRSS!department) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then oRS.AddNew oRS!department = Field2Str(oRSS!department) oRS!employeenumber = Field2Str(oRSS!employeenumber) oRS!lastname = Field2Str(Trim$(oRSS!lastname)) oRS!firstname = Field2Str(Trim$(oRSS!firstname)) oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber) If Field2Str(oRSS!defaultwccode) = "" Then If oRS!department = "53" Then oRS!wc_code = "0005022" ElseIf oRS!department = "52" Then oRS!wc_code = "0005443" ElseIf oRS!department = "54" Then oRS!wc_code = "0005443" ElseIf oRS!department = "55" Then oRS!wc_code = "0005606" ElseIf oRS!department = "50" Then oRS!wc_code = "0005443" ElseIf oRS!department = "62" Then oRS!wc_code = "0008810" ElseIf oRS!department = "61" Then oRS!wc_code = "0008810" End If Else oRS!wc_code = Field2Str(oRSS!defaultwccode) End If oRS!terminated = Field2Str(oRSS!employeestatus_AIT) oRS.Update ElseIf Field2Str(oRSS!department) <> Field2Str(oRS!department) Then oRS.Delete oRS.AddNew oRS!department = Field2Str(oRSS!department) oRS!employeenumber = Field2Str(oRSS!employeenumber) oRS!lastname = Field2Str(Trim$(oRSS!lastname)) oRS!firstname = Field2Str(Trim$(oRSS!firstname)) oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber) If Field2Str(oRSS!defaultwccode) = "" Then If oRS!department = "53" Then oRS!wc_code = "0005022" ElseIf oRS!department = "52" Then oRS!wc_code = "0005443" ElseIf oRS!department = "54" Then oRS!wc_code = "0005443" ElseIf oRS!department = "55" Then oRS!wc_code = "0005606" ElseIf oRS!department = "50" Then oRS!wc_code = "0005443" ElseIf oRS!department = "62" Then oRS!wc_code = "0008810" ElseIf oRS!department = "61" Then oRS!wc_code = "0008810" End If Else oRS!wc_code = Field2Str(oRSS!defaultwccode) End If oRS!terminated = Field2Str(oRSS!employeestatus_AIT) oRS.Update ' End If Else If Field2Str(oRSS!defaultwccode) = "" Then If oRS!department = "53" Then oRS!wc_code = "0005022" ElseIf oRS!department = "52" Then oRS!wc_code = "0005443" ElseIf oRS!department = "54" Then oRS!wc_code = "0005443" ElseIf oRS!department = "55" Then oRS!wc_code = "0005606" ElseIf oRS!department = "50" Then oRS!wc_code = "0005443" ElseIf oRS!department = "62" Then oRS!wc_code = "0008810" ElseIf oRS!department = "61" Then oRS!wc_code = "0008810" End If Else oRS!wc_code = Field2Str(oRSS!defaultwccode) End If oRS!terminated = Field2Str(oRSS!employeestatus_AIT) oRS.Update End If oRSS.MoveNext Loop Screen.MousePointer = vbDefault MsgBox "Employee Master Information Has Been Updated" cmdExit.SetFocus Exit Sub Error_EH: gstrMODULE = "Form PayList - Module cmdPRProcess_Click" Call ErrorHandler2 gstrMODULE = "" Screen.MousePointer = vbDefault Exit Sub End Sub Private Sub dtpPayDate_Change() Call PayLoad cmdAdd.SetFocus End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH ' mboolSETUP = False ' mboolENTER = False Exit Sub Error_EH: gstrMODULE = "Form PayList - 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 = vbKeyP Then ' Display key combinations. If CtrlDown Then Call lstPayCrews_DblClick ' Call PayLoad ' Call cmdTotal_Click End If Exit Sub End If If KeyCode = vbKeyA Then ' Display key combinations. If CtrlDown Then Call cmdAdd_Click ' Call CrewLoad ' Call cmdTotal_Click End If Exit Sub End If If KeyCode = vbKeyM Then ' Display key combinations. If CtrlDown Then Call cmdAddMember_Click ' Call CrewLoad ' Call cmdTotal_Click ' Call lstLots_DblClick End If Exit Sub End If 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 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 frmPayList.Width = 4725 dtpPayDate.Value = Date Call PayLoad Exit Sub Error_EH: gstrMODULE = "Form PayList - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblCrew Order BY Crew_Boss" Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly lstCrew.Clear Do Until moRSCREW.EOF With lstCrew .AddItem Field2Str(moRSCREW!crew_boss) .ItemData(.NewIndex) = moRSCREW!crew_id End With moRSCREW.MoveNext Loop ' moRSCrew.Close frmPayList.Width = 9150 Exit Sub Error_EH: gstrMODULE = "Form PayList - Module ProjLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstCrew_DblClick() txtCrewId = lstCrew.ItemData(lstCrew.ListIndex) frmPayList.Width = 4725 cmdAdd.Enabled = True cmdDelete.Enabled = True Call FormSave End Sub Private Sub lstPayCrews_DblClick() gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex) gintCREWID = CInt(Left(lstPayCrews.Text, 3)) Load frmPayHead frmPayHead.lblCrewName = Trim$(Mid$(lstPayCrews.Text, InStr(lstPayCrews.Text, vbTab) + 1)) frmPayHead.txtPayDate = dtpPayDate.Value frmPayHead.txtCrewId = gintCREWID frmPayHead.Show 1 End Sub