azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
0a264ee3fabfdfded7e2bb64dc86ece16c31d99e
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Current/frmEmployee.frm
Mike Swanson 5359e7c49e feat(valleywide): recover VWP Orders VB6 source from D: backup drive 
Recovered Darv's VB6 source for the Valley Wide Plastering Orders
application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used).
This is the first time we've had the actual source — prior session only
had a single frmPayroll.frm from the AD server.

Three project variants identified across two snapshots:
- Full-Project/   (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\
- Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\
- Source/         (170 files, 559 MB)   — D:\Office-Estimates\Darv\Source\ wholesale
- SOURCE-HOLD/    (3 files, 1 MB)       — D:\Office-Estimates\Darv\SOURCE HOLD\

Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production
Orders_10A.exe was live as of April 2024 — open question whether newer
source exists on other backup drives Mike will scan next.

Also includes per-category and per-keyword analysis CSVs from a WizTree
file-list export, plus the analyzer script that produced them
(re-runnable for the next drive's CSV).

VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live
VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:36:27 -07:00

1516 lines
46 KiB
Plaintext
Raw Blame History

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 = 5445
ClientLeft = 60
ClientTop = 345
ClientWidth = 7545
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 = 5445
ScaleWidth = 7545
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtNewCMS
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 = 2220
TabIndex = 36
Top = 1470
Width = 1035
End
Begin VB.CheckBox chkRENUM
Caption = "Renum CMS"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3345
TabIndex = 35
Top = 1545
Width = 1575
End
Begin VB.TextBox txtCMS2
Alignment = 1 'Right Justify
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 = 5115
TabIndex = 13
Top = 2100
Width = 585
End
Begin VB.TextBox txtRTRate2
Alignment = 1 'Right Justify
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 = 6045
TabIndex = 14
Top = 2100
Width = 600
End
Begin VB.TextBox txtOTRate2
Alignment = 1 'Right Justify
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 = 6885
TabIndex = 15
Top = 2100
Width = 600
End
Begin VB.TextBox txtCMS1
Alignment = 1 'Right Justify
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 = 5115
TabIndex = 10
Top = 1770
Width = 585
End
Begin VB.CheckBox chkHrly
Alignment = 1 'Right Justify
Caption = "Hourly"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 3090
TabIndex = 9
Top = 870
Width = 765
End
Begin VB.TextBox txtOTRate
Alignment = 1 'Right Justify
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 = 6870
TabIndex = 12
Top = 1770
Width = 600
End
Begin VB.TextBox txtRTRate
Alignment = 1 'Right Justify
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 = 6045
TabIndex = 11
Top = 1770
Width = 600
End
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 = 7
Top = 300
Width = 1035
End
Begin Crystal.CrystalReport crEmpList
Left = 4335
Top = 1935
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "Print"
Height = 465
Left = 2235
TabIndex = 31
Top = 1845
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 = 8
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 = 90
List = "frmEmployee.frx":0048
Style = 2 'Dropdown List
TabIndex = 29
Top = 1095
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 = 28
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 = 2400
TabIndex = 5
Top = 1110
Visible = 0 'False
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 = 3405
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 = 50
TabIndex = 3
Top = 15
Width = 3405
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 = 1935
MaxLength = 7
TabIndex = 2
Top = 15
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 = 3315
TabIndex = 18
Top = 1845
Width = 900
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 465
Left = 1170
TabIndex = 16
Top = 1845
Width = 900
End
Begin VB.CommandButton cmdAdd
Caption = "Add"
Height = 465
Left = 90
TabIndex = 17
Top = 1845
Width = 900
End
Begin LpLib.fpList lstEmpList
Height = 2565
Left = 60
TabIndex = 0
Top = 2415
Width = 7410
_Version = 196608
_ExtentX = 13070
_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 lblNewCMS
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "New CMS Number:"
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 = 825
TabIndex = 37
Top = 1500
Width = 1365
End
Begin VB.Label lblCMSCd
AutoSize = -1 'True
Caption = "CMS Pay Cd"
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 = 4935
TabIndex = 34
Top = 1530
Width = 900
End
Begin VB.Label lblRTRate
AutoSize = -1 'True
Caption = "Reg Rate:"
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 = 5970
TabIndex = 33
Top = 1530
Width = 735
End
Begin VB.Label lblOTRate
AutoSize = -1 'True
Caption = "OT Rate"
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 = 6870
TabIndex = 32
Top = 1530
Width = 615
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 = 30
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 = 27
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 = 120
TabIndex = 26
Top = 885
Width = 705
End
Begin VB.Label lblIntr
Alignment = 2 'Center
Caption = "Double Click Hi-Lited Selection To Edit"
ForeColor = &H000000FF&
Height = 285
Left = 180
TabIndex = 25
Top = 5070
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 = 24
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 = 23
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 = 22
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 = 21
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 = 20
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 = 19
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!Rate = Field2Str2(txtRTRate)
oRS!OTRate = Field2Str2(txtOTRate)
oRS!Rate = Field2Str2(txtRTRate)
oRS!OTRate2 = Field2Str2(txtOTRate2)
oRS!RegRate2 = Field2Str2(txtRTRate2)
oRS!RATECD1 = Field2Str2(txtCMS1)
oRS!RATECD2 = Field2Str2(txtCMS2)
oRS!Hourly = Field2CheckBox(chkHrly)
oRS!RENum = Field2CheckBox(chkRENUM)
oRS!NEWCMS = Field2Str(txtNewCMS)
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)
!Rate = Field2Str2(txtRTRate)
!OTRate = Field2Str2(txtOTRate)
!Hourly = Field2CheckBox(chkHrly)
!RENum = Field2CheckBox(chkRENUM)
!NEWCMS = Field2Str(txtNewCMS)
!OTRate2 = Field2Str2(txtOTRate2)
!RegRate2 = Field2Str2(txtRTRate2)
!RATECD1 = Field2Str2(txtCMS1)
!RATECD2 = Field2Str2(txtCMS2)
.Update
End With
Exit Sub
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 chkHrly_LostFocus()
If chkHrly = vbChecked Then
txtOTRate.Enabled = True
txtOTRate2.Enabled = True
txtRTRate.Enabled = True
txtRTRate2.Enabled = True
txtCMS1.Enabled = True
txtCMS2.Enabled = True
txtCMS1.SetFocus
ElseIf chkHrly = vbUnchecked Then
txtOTRate.Enabled = False
txtOTRate2.Enabled = False
txtRTRate.Enabled = False
txtRTRate2.Enabled = False
txtCMS1.Enabled = False
txtCMS2.Enabled = False
If cmdSave.Enabled = True Then
cmdSave.SetFocus
End If
End If
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 = ""
txtRTRate = ""
txtOTRate = ""
chkHrly = vbUnchecked
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()
Dim strTEST As String
On Error GoTo Error_EH
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)
txtRTRate = Format(Field2Str2(!Rate), "#,0.00")
txtOTRate = Format(Field2Str2(!OTRate), "#,0.00")
txtRTRate2 = Format(Field2Str2(!RegRate2), "#,0.00")
txtOTRate2 = Format(Field2Str2(!OTRate2), "#,0.00")
chkRENUM = Field2CheckBox(!RENum)
txtNewCMS = Field2Str(!NEWCMS)
txtCMS1 = Field2Str(!RATECD1)
txtCMS2 = Field2Str(!RATECD2)
If Field2Str(!Hourly) = True Then
chkHrly = vbChecked
txtOTRate.Enabled = True
txtOTRate2.Enabled = True
txtRTRate.Enabled = True
txtRTRate2.Enabled = True
txtCMS1.Enabled = True
txtCMS2.Enabled = True
ElseIf Field2Str(!Hourly) = False Then
chkHrly = vbUnchecked
txtOTRate.Enabled = False
txtOTRate2.Enabled = False
txtRTRate.Enabled = False
txtRTRate2.Enabled = False
txtCMS1.Enabled = False
txtCMS2.Enabled = False
End If
strTEST = Field2Str(!RENum)
If (!RENum) Then
' txtOTRate.Enabled = False
' txtOTRate2.Enabled = False
' txtRTRate.Enabled = False
' txtRTRate2.Enabled = False
txtCMS1.Enabled = False
txtCMS2.Enabled = False
txtDept.Enabled = False
txtEmpNo.Enabled = False
txtFName.Enabled = False
txtLName.Enabled = False
cboWCCode.Enabled = False
txtSS.Enabled = False
txtStatus.Enabled = False
chkRENUM.Enabled = False
txtNewCMS.Enabled = False
txtCMS1.Enabled = False
txtCMS2.Enabled = False
Else
' txtOTRate.Enabled = False
' txtOTRate2.Enabled = False
' txtRTRate.Enabled = False
' txtRTRate2.Enabled = False
txtCMS1.Enabled = True
txtCMS2.Enabled = True
txtDept.Enabled = True
txtEmpNo.Enabled = True
txtFName.Enabled = True
txtLName.Enabled = True
cboWCCode.Enabled = True
txtSS.Enabled = True
txtStatus.Enabled = True
chkRENUM.Enabled = True
txtNewCMS.Enabled = True
txtCMS1.Enabled = True
txtCMS2.Enabled = True
End If
End With
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 txtCMS1_GotFocus()
Call FieldSelect(txtCMS1)
End Sub
Private Sub txtCMS2_GotFocus()
Call FieldSelect(txtCMS2)
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 txtNewCMS_LostFocus()
cmdSave.SetFocus
End Sub
Private Sub txtOTRate_GotFocus()
Call FieldSelect(txtOTRate)
End Sub
Private Sub txtOTRate_LostFocus()
txtOTRate = Format(txtOTRate, "#,#.00")
End Sub
Private Sub txtOTRate2_GotFocus()
Call FieldSelect(txtOTRate2)
End Sub
Private Sub txtRTRate_GotFocus()
Call FieldSelect(txtRTRate)
End Sub
Private Sub txtRTRate_LostFocus()
txtRTRate = Format(txtRTRate, "#,#.00")
End Sub
Private Sub txtRTRate2_GotFocus()
Call FieldSelect(txtRTRate2)
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
Reference in New Issue View Git Blame Copy Permalink