VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX" Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmEmployee Caption = "Employee Information" ClientHeight = 5340 ClientLeft = 60 ClientTop = 345 ClientWidth = 7425 BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 5340 ScaleWidth = 7425 StartUpPosition = 3 'Windows Default Begin VB.ComboBox cboWCCode BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmEmployee.frx":0000 Left = 1935 List = "frmEmployee.frx":0010 Style = 2 'Dropdown List TabIndex = 25 Top = 300 Width = 1035 End Begin VB.CommandButton cmdLookUP Caption = "Check Number" Height = 465 Left = 3009 TabIndex = 24 Top = 1455 Visible = 0 'False Width = 945 End Begin Crystal.CrystalReport crEmpList Left = 6780 Top = 165 _ExtentX = 741 _ExtentY = 741 _Version = 348160 PrintFileLinesPerPage= 60 End Begin VB.CommandButton cmdPrint Caption = "Print" Height = 465 Left = 2031 TabIndex = 23 Top = 1455 Width = 900 End Begin VB.TextBox txtSS BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 4095 MaxLength = 9 TabIndex = 7 Top = 585 Width = 2595 End Begin VB.ComboBox cboSort BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmEmployee.frx":0038 Left = 120 List = "frmEmployee.frx":0048 Style = 2 'Dropdown List TabIndex = 21 Top = 840 Width = 2220 End Begin VB.TextBox txtSearch BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3900 TabIndex = 20 Top = 1110 Width = 3435 End Begin VB.TextBox txtStatus BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 585 TabIndex = 6 Top = 300 Width = 480 End Begin VB.TextBox txtWCCode BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 2430 TabIndex = 5 Top = 900 Width = 1035 End Begin VB.TextBox txtFName BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 4095 MaxLength = 20 TabIndex = 4 Top = 300 Width = 2595 End Begin VB.TextBox txtLName BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 4095 MaxLength = 15 TabIndex = 3 Top = 15 Width = 2595 End Begin VB.TextBox txtEmpNo Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 1920 MaxLength = 7 TabIndex = 2 Top = 0 Width = 1035 End Begin VB.TextBox txtDept BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 585 TabIndex = 1 Top = 15 Width = 480 End Begin VB.CommandButton cmdExit Caption = "Exit" Height = 465 Left = 4035 TabIndex = 10 Top = 1455 Width = 900 End Begin VB.CommandButton cmdSave Caption = "Save" Enabled = 0 'False Height = 465 Left = 1053 TabIndex = 8 Top = 1455 Width = 900 End Begin VB.CommandButton cmdAdd Caption = "Add" Height = 465 Left = 75 TabIndex = 9 Top = 1455 Width = 900 End Begin LpLib.fpList lstEmpList Height = 2565 Left = 105 TabIndex = 0 Top = 1950 Width = 7275 _Version = 196608 _ExtentX = 12832 _ExtentY = 4524 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 = 7 Sorted = 0 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= -1 'True ColumnHeaderHeight= 195 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmEmployee.frx":0075 End Begin VB.Label lblSS Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "SS #: " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3570 TabIndex = 22 Top = 660 Width = 450 End Begin VB.Label lblSearch AutoSize = -1 'True Caption = "Enter Employee No Search Info:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3900 TabIndex = 19 Top = 885 Width = 2280 End Begin VB.Label lblSort AutoSize = -1 'True Caption = "Sort Field:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 150 TabIndex = 18 Top = 630 Width = 705 End Begin VB.Label lblIntr Alignment = 2 'Center Caption = "Double Click Hi-Lited Selection To Edit" ForeColor = &H000000FF& Height = 285 Left = 150 TabIndex = 17 Top = 4785 Width = 7215 End Begin VB.Label lblStatus AutoSize = -1 'True Caption = "A / I:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 180 TabIndex = 16 Top = 360 Width = 360 End Begin VB.Label lblWCCode AutoSize = -1 'True Caption = "WC Code:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 1155 TabIndex = 15 Top = 360 Width = 735 End Begin VB.Label lblFName AutoSize = -1 'True Caption = "First Name:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3225 TabIndex = 14 Top = 360 Width = 795 End Begin VB.Label lblLName AutoSize = -1 'True Caption = "Last Name:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3240 TabIndex = 13 Top = 75 Width = 810 End Begin VB.Label lblEmpNo AutoSize = -1 'True Caption = "Emp No:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 1275 TabIndex = 12 Top = 75 Width = 615 End Begin VB.Label lblDept AutoSize = -1 'True Caption = "Dept:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 150 TabIndex = 11 Top = 75 Width = 390 End End Attribute VB_Name = "frmEmployee" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim mboolSHOW As Boolean, mboolADD As Boolean Dim moRSEMP As Recordset, mintBOOKMARK As Integer Dim mbytSort As Byte Private Sub FieldSave() Dim oRS As Recordset, strSQL As String If mboolADD Then strSQL = "SELECT * FROM PR1_EmployeeMaster" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockPessimistic If txtEmpNo = "" Then MsgBox "You Must Enter Information To Add An Employee", vbOKOnly, "Missing Information" cmdADD.Enabled = True cmdSave.Enabled = False txtEmpNo.Enabled = False lstEmpList.Enabled = True Exit Sub Else If Not oRS.EOF Then oRS.AddNew oRS!department = Field2Str(txtDept) oRS!EmployeeNumber = Field2Str(txtEmpNo) oRS!FirstName = Field2Str(txtFName) oRS!LastName = Field2Str(txtLName) oRS!wc_code = cboWCCode.Text ' oRS!wc_code = Field2Str(txtWCCode) oRS!Terminated = Field2Str(txtStatus) oRS!SocialSecurityNumber = Field2Str(txtSS) oRS!ECODE = Right(txtEmpNo, 4) oRS.Update mboolADD = False End If End If Exit Sub End If With moRSEMP !department = Field2Str(txtDept) !EmployeeNumber = Field2Str(txtEmpNo) !FirstName = Field2Str(txtFName) !LastName = Field2Str(txtLName) !wc_code = cboWCCode.Text ' !wc_code = Field2Str(txtWCCode) !SocialSecurityNumber = Field2Str(txtSS) !Terminated = Field2Str(txtStatus) !ECODE = Right(txtEmpNo, 4) .Update End With Error_EH: gstrMODULE = "Form Employhee - Module FieldSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetEmpNo() Dim strSQL As String, oRS As Recordset, strMSG As String, intCOUNT As Integer, intTEST As Integer Dim strSQLL As String, oRSS As Recordset, strLastEmpNo As String Dim strSQLLL As String, oRSSS As Recordset Dim strSQLLLL As String, oRSSSS As Recordset strSQL = "SELECT * FROM PR1_EMPLOYEEMASTER WHERE ECODE = '" & Right$(txtEmpNo, 4) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly intTEST = oRS.RecordCount intCOUNT = 0 If Not oRS.EOF Then strMSG = "Employee Master" & vbCrLf ' & vbCrLf If oRS.RecordCount > 0 Then Do Until intCOUNT = oRS.RecordCount ' strMSG = "Employee Master" & vbCrLf & vbCrLf strMSG = strMSG & Field2Str(oRS!EmployeeNumber) & " - " & Trim$(Field2Str(oRS!FirstName)) & " " & Trim$(Field2Str(oRS!LastName)) & vbCrLf intCOUNT = intCOUNT + 1 oRS.MoveNext Loop End If End If strSQLL = "SELECT * FROM tblCREW WHERE right(EMPNO,4) = '" & Right$(txtEmpNo, 4) & "'" ' strSQLL = "SELECT * FROM tblCREW WHERE EMPNO = '" & txtEmpNo & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly intTEST = oRSS.RecordCount intCOUNT = 0 If Not oRSS.EOF Then strMSG = strMSG & vbCrLf & "Crew Leader" & vbCrLf ' & vbCrLf If oRSS.RecordCount > 0 Then Do Until intCOUNT = oRSS.RecordCount ' strMSG = "Employee Master" & vbCrLf & vbCrLf strMSG = strMSG & Field2Str(oRSS!Crew_ID) & " -- " & Field2Str(oRSS!EmpNo) & " - " & Trim$(Field2Str(oRSS!Crew_Boss)) & vbCrLf intCOUNT = intCOUNT + 1 oRSS.MoveNext Loop End If End If strSQLLL = "SELECT * FROM tblCREWLIST WHERE right$(EMP_ID,4) = '" & Right$(txtEmpNo, 4) & "'" ' strSQLLL = "SELECT * FROM tblCREWLIST WHERE EMP_ID = '" & txtEmpNo & "'" Set oRSSS = New Recordset oRSSS.Open strSQLLL, goConn, adOpenForwardOnly, adLockReadOnly intTEST = oRSSS.RecordCount intCOUNT = 0 If Not oRSSS.EOF Then strMSG = strMSG & vbCrLf & "Crew List" & vbCrLf ' & vbCrLf If oRSSS.RecordCount > 0 Then Do Until intCOUNT = oRSSS.RecordCount ' strMSG = "Employee Master" & vbCrLf & vbCrLf strMSG = strMSG & Field2Str(oRSSS!Crew_ID) & " -- " & Field2Str(oRSSS!Emp_ID) & " - " & Trim$(Field2Str(oRSSS!EmpName)) & vbCrLf intCOUNT = intCOUNT + 1 oRSSS.MoveNext Loop End If End If ' strSQLLLL = "SELECT * FROM tblPAYCREW WHERE EMP_ID = '" & txtEmpNo & "'" strSQLLLL = "SELECT * FROM tblPAYCREW WHERE right$(EMP_ID,4) = '" & Right$(txtEmpNo, 4) & "' ORDER BY EMP_ID" Set oRSSSS = New Recordset oRSSSS.Open strSQLLLL, goConn, adOpenForwardOnly, adLockReadOnly intTEST = oRSSSS.RecordCount intCOUNT = 0 If Not oRSSSS.EOF Then strLastEmpNo = "" strMSG = strMSG & vbCrLf & "Pay Crew" & vbCrLf ' & vbCrLf If oRSSSS.RecordCount > 0 Then Do Until intCOUNT = oRSSSS.RecordCount If strLastEmpNo <> oRSSSS!Emp_ID Then ' strMSG = "Employee Master" & vbCrLf & vbCrLf strMSG = strMSG & Field2Str(oRSSSS!Emp_ID) & " - " & Trim$(Field2Str(oRSSSS!EmpName)) & " " & Trim$(Field2Str(oRSSSS!Pay_Date)) & vbCrLf ' strMSG = strMSG & Field2Str(oRSSSS!Emp_ID) & " - " & Trim$(Field2Str(oRSSSS!EmpName)) & " " & Trim$(Field2Str(oRSSSS!PayDate)) & vbCrLf ' intCOUNT = intCOUNT + 1 strLastEmpNo = oRSSSS!Emp_ID End If intCOUNT = intCOUNT + 1 oRSSSS.MoveNext Loop End If End If MsgBox strMSG, vbOKOnly, "Current Employees" oRS.Close End Sub Private Sub EmpLoad() Dim oRS As Recordset, moRSEMP As Recordset Dim strSQL As String, strCREW As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from PR1_EmployeeMaster" ' WHERE crew_id = " & Field2Str(lblCrewId.Caption) & " ORDER BY emp_id" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstEmpList.Clear Do Until oRS.EOF With lstEmpList strLine = Field2Str(oRS!department) & vbTab & Field2Str(oRS!EmployeeNumber) & vbTab & Field2Str(oRS!FirstName) strLine = strLine & vbTab & Field2Str(oRS!LastName) & vbTab & Field2Str(oRS!wc_code) & vbTab & Field2Str(oRS!Terminated) & vbTab & Field2Str(oRS!SocialSecurityNumber) .AddItem strLine ' .ItemData(.NewIndex) = moRSEMP!emp_id End With oRS.MoveNext Loop oRS.Close ' Do Until moRSEMP.EOF ' With lstEmpList ' strLine = Field2Str(moRSEMP!department) & vbTab & Field2Str(moRSEMP!employeenumber) & vbTab & Field2Str(moRSEMP!firstname) ' strLine = strLine & vbTab & Field2Str(moRSEMP!lastname) & vbTab & Field2Str(moRSEMP!wc_code) & vbTab & Field2Str(moRSEMP!Terminated) & vbTab & Field2Str(moRSEMP!SocialSecurityNumber) ' .AddItem strLine ' .ItemData(.NewIndex) = moRSEMP!emp_id ' End With ' moRSEMP.MoveNext ' Loop ' moRSEMP.Close If lstEmpList.ListCount Then lstEmpList.ListIndex = 0 Else lstEmpList.ListIndex = -1 ' cmdDelete.Enabled = False End If Exit Sub Error_EH: gstrMODULE = "Form Employee - Module EmpLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAdd_Click() ' mboolbookmark = lstEmpList.ListIndex txtEmpNo.Enabled = True mboolADD = True cmdADD.Enabled = False cmdSave.Enabled = True Call FormClear txtDept.SetFocus lstEmpList.Enabled = False ' lstEmpList.ListIndex = mintBOOKMARK End Sub Private Sub FormClear() txtEmpNo.Enabled = True txtDept = "" txtEmpNo = "" txtFName = "" txtLName = "" cboWCCode.ListIndex = -1 ' txtWCCode = "" txtSS = "" txtStatus = "" End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdPrint_Click() Dim intYN As Integer, strMSG As String strMSG = "Do You Want To A Report Sorted By Employee Number" intYN = MsgBox(strMSG, vbYesNo, "Sort By Employee Number") If intYN = vbYes Then Call PrintEmpNo ElseIf intYN = vbNo Then intYN = MsgBox("Do You Want To Print A Report Sorted By Last Name", vbYesNo, "Sort By Last Name") If intYN = vbYes Then Call PrintLName ElseIf intYN = vbNo Then intYN = MsgBox("Do You Want To Print A Report Sorted By First Name?", vbYesNo, "Sorted By First Name") If intYN = vbYes Then Call PrintFName ElseIf intYN = vbNo Then Exit Sub End If End If End If End Sub Private Sub PrintEmpNo() Dim intYN As Integer, strMSG As String intYN = MsgBox("Do You Want To Print To Screen?", vbYesNo, "Print To Screen") If intYN = vbYes Then crEmpList.Destination = crptToWindow Else crEmpList.Destination = crptToPrinter End If crEmpList.ReportFileName = App.Path & "\EmpListByEmpNo.rpt" ' crEmpList.Destination = crptToPrinter 'EmpListByEmpLN 'EmpListByEmpFN crEmpList.Action = 1 End Sub Private Sub PrintLName() Dim intYN As Integer, strMSG As String intYN = MsgBox("Do You Want To Print To Screen?", vbYesNo, "Print To Screen") If intYN = vbYes Then crEmpList.Destination = crptToWindow Else crEmpList.Destination = crptToPrinter End If crEmpList.ReportFileName = App.Path & "\EmpListByEmpLN.rpt" ' crEmpList.Destination = crptToPrinter 'EmpListByEmpLN 'EmpListByEmpFN crEmpList.Action = 1 End Sub Private Sub PrintFName() Dim intYN As Integer, strMSG As String intYN = MsgBox("Do You Want To Print To Screen?", vbYesNo, "Print To Screen") If intYN = vbYes Then crEmpList.Destination = crptToWindow Else crEmpList.Destination = crptToPrinter End If crEmpList.ReportFileName = App.Path & "\EmpListByEmpFN.rpt" ' crEmpList.Destination = crptToPrinter 'EmpListByEmpLN 'EmpListByEmpFN crEmpList.Action = 1 End Sub Private Sub cmdSave_Click() mintBOOKMARK = lstEmpList.ListIndex Call FieldSave Call EmpLoad cmdADD.Enabled = True cmdSave.Enabled = False txtEmpNo.Enabled = False lstEmpList.Enabled = True lstEmpList.ListIndex = mintBOOKMARK End Sub Private Sub Form_Load() mboolADD = False Call EmpLoad cboSort.ListIndex = 0 End Sub Private Sub FormShow() On Error GoTo Error_EH ' mboolSHOW = True ' gintESTID = moRS!EST_id ' txtProject = Trim$(Field2Str(moRSProj!proj_id)) & " " & Trim$(moRSProj!proj_code) & " " & moRSProj!proj_desc ' chkBill = Field2CheckBox(moRSProj!bill) ' chkOption = Field2CheckBox(moRSProj!opt) With moRSEMP txtDept = Field2Str(!department) txtEmpNo = Field2Str(!EmployeeNumber) txtFName = Field2Str(!FirstName) txtLName = Field2Str(!LastName) cboWCCode = Field2Str(!wc_code) ' txtWCCode = Field2Str(!wc_code) txtSS = Field2Str(!SocialSecurityNumber) txtStatus = Field2Str(!Terminated) ' txtPNTCode = Field2Str(!pnt_code) ' txtLCode = Field2Str(!l_code) ' txtSCode = Field2Str(!s_code) ' txtSTCode = Field2Str(!st_code) End With ' mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Employee - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstEmpList_Click() Dim strSQL As String If lstEmpList.ListIndex <> -1 Then If FormFind() Then Call FormShow ' Call OptLoad End If End If End Sub Private Function FormFind() As Boolean Dim strSQL As String, intResponse As Integer, strEMPNO As String On Error GoTo Error_EH lstEmpList.col = 1 '****** strEMPNO = lstEmpList.ColText strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strEMPNO & "'" Set moRSEMP = New Recordset moRSEMP.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSEMP.EOF Then FormFind = False ' Call FormClear ' Call OptClear Else FormFind = True End If Exit Function Error_EH: gstrMODULE = "Form Employee - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub lstEmpList_DblClick() lstEmpList.Enabled = False cmdADD.Enabled = False cmdSave.Enabled = True txtDept.SetFocus End Sub Private Sub txtDept_GotFocus() Call FieldSelect(txtDept) ' txtDept.SelStart = 0 ' If lstCtrl.MaxLength > 0 Then ' lstCtrl.SelLength = lstCtrl.MaxLength ' Else ' txtDept.SelLength = 50 ' txtDept.SelText ' End If End Sub Private Sub txtDept_LostFocus() txtDept = UCase(txtDept) End Sub Private Sub txtEmpNo_GotFocus() Call FieldSelect(txtEmpNo) End Sub Private Sub txtEmpNo_LostFocus() ' txtEmpNo = UCase(txtEmpNo) Call GetEmpNo End Sub Private Sub txtFName_GotFocus() Call FieldSelect(txtFName) End Sub Private Sub txtFName_LostFocus() txtFName = UCase(txtFName) End Sub Private Sub txtLName_GotFocus() Call FieldSelect(txtLName) End Sub Private Sub txtLName_LostFocus() txtLName = UCase(txtLName) End Sub Private Sub txtStatus_GotFocus() Call FieldSelect(txtStatus) End Sub Private Sub txtStatus_LostFocus() txtStatus = UCase(txtStatus) End Sub 'Private Sub txtWCCode_GotFocus() ' Call FieldSelect(txtWCCode) 'End Sub 'Private Sub txtWCCode_LostFocus() 'Dim lngWC As Long, intYN As Integer, strMSG As String '' txtWCCode = UCase(txtWCCode) ' If Len(txtWCCode) < 4 Then ' MsgBox "This WC Code Is Too Short - ReEnter A Valid WC Code", vbOKOnly, "Invalid WC Code" ' txtWCCode.SetFocus ' ElseIf Len(txtWCCode) = 4 Then ' txtWCCode = Format((txtWCCode), "0000000") '' txtWCCode = Format("000####", CDbl(txtWCCode)) ' ElseIf Len(txtWCCode) = 5 Then ' txtWCCode = Format((txtWCCode), "0000000") ' ElseIf Len(txtWCCode) = 6 Then ' txtWCCode = Format((txtWCCode), "0000000") ' ElseIf Len(txtWCCode) = 7 Then ' txtWCCode = Format((txtWCCode), "0000000") ' 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 cboSort_Click() Dim intMIN As Integer On Error Resume Next ' mintCnt2 = mintCnt2 + 1 ' lblCount2 = mintCnt2 ' mdteBegin = Now ' cboSortOrder.ListIndex = cboSort.ListIndex ' cboSortOrder.ListIndex = 4 If cboSort.ListIndex = 0 Then ' If mbytSort <> cbolistindex Then If mbytSort = 6 Then ' Call InventoryLoad End If lstEmpList.col = 3 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone ' lstEmpList.col = 3 ' lstEmpList.ColSortSeq = -1 ' lstEmpList.ColSorted = SortedNone lstEmpList.col = 2 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 1 lstEmpList.ColSortSeq = 0 lstEmpList.ColSorted = SortedAscending lstEmpList.Redraw = True lstEmpList.ColSortDataType = ColSortDataTypeTextNoCase lstEmpList.SearchIgnoreCase = True lstEmpList.ColumnSearch = 1 txtSearch = "" txtSearch.SetFocus lblSearch.Caption = "Enter Employee Num. Search Info:" ElseIf cboSort.ListIndex = 1 Then If mbytSort = 6 Then ' Call InventoryLoad End If lstEmpList.col = 2 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 1 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 3 lstEmpList.ColSortSeq = 0 lstEmpList.ColSorted = SortedAscending lstEmpList.Redraw = True lstEmpList.ColSortDataType = ColSortDataTypeTextNoCase lstEmpList.SearchIgnoreCase = True ' lstEmpList.ColumnSearch = 2 lstEmpList.ColumnSearch = 3 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else txtSearch = "" txtSearch.SetFocus ' End If ' txtSearch = "" lblSearch.Caption = "Enter Last Name Search Information:" ' txtSearch.SetFocus ElseIf cboSort.ListIndex = 2 Then If mbytSort = 6 Then ' Call InventoryLoad End If lstEmpList.col = 2 lstEmpList.ColSortSeq = 0 lstEmpList.ColSorted = SortedAscending lstEmpList.col = 1 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 3 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.Redraw = True lstEmpList.ColSortDataType = ColSortDataTypeTextNoCase lstEmpList.SearchIgnoreCase = True lstEmpList.ColumnSearch = 2 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else txtSearch = "" txtSearch.SetFocus ' End If lblSearch.Caption = "Enter First Name Search Information:" ' txtSearch.SetFocus ' End If ElseIf cboSort.ListIndex = 3 Then If mbytSort = 6 Then ' Call InventoryLoad End If lstEmpList.col = 0 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 1 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.col = 6 lstEmpList.ColSortSeq = 0 lstEmpList.ColSorted = SortedAscending lstEmpList.col = 2 lstEmpList.ColSortSeq = -1 lstEmpList.ColSorted = SortedNone lstEmpList.Redraw = True lstEmpList.ColSortDataType = ColSortDataTypeTextNoCase lstEmpList.SearchIgnoreCase = True ' lstEmpList.ColumnSearch = 2 lstEmpList.ColumnSearch = 6 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else txtSearch = "" txtSearch.SetFocus ' End If lblSearch.Caption = "Enter SS Number Search Information:" ' txtSearch.SetFocus End If mbytSort = cboSort.ListIndex ' mdteEnd = Now ' intMIN = DateDiff("s", mdteBegin, mdteEnd) ' lblDteBegin = Format(mdteBegin, "HH:MM:SS") ' lbldteEnd = Format(mdteEnd, "HH:MM:SS") ' lblDiff = intMIN End Sub Private Sub txtSearch_Change() 'Multiple character search code. lstEmpList.SearchText = txtSearch.Text lstEmpList.SearchMethod = 2 lstEmpList.Action = ActionSearch lstEmpList.SearchIndex = -1 lstEmpList.Action = 0 If lstEmpList.SearchIndex <> -1 Then lstEmpList.TopIndex = lstEmpList.SearchIndex lstEmpList.ListIndex = lstEmpList.SearchIndex Else lstEmpList.Action = 6 ' clear End If End Sub