azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Current/frmPayHead.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

3600 lines
114 KiB
Plaintext
Raw Permalink Blame History

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 frmPayHead
Caption = "Payroll Summary Information"
ClientHeight = 5850
ClientLeft = 165
ClientTop = 450
ClientWidth = 12390
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5850
ScaleWidth = 12390
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdMoveHouse
Caption = "Move Amt To House"
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 = 2475
TabIndex = 86
Top = 5265
Width = 1155
End
Begin VB.CommandButton cmdAllCrew
Caption = "Get Crew Pay"
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 = 5400
TabIndex = 85
Top = 5265
Width = 1155
End
Begin VB.CommandButton cmd1Emp
Caption = "Get 1 Emp Pay"
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 = 3855
TabIndex = 84
Top = 5265
Width = 1155
End
Begin LpLib.fpList lstPaySheets
Height = 1080
Left = 3780
TabIndex = 77
Top = 1785
Visible = 0 'False
Width = 4335
_Version = 196608
_ExtentX = 7646
_ExtentY = 1905
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 = 8
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= -1 'True
ColumnHeaderHeight= 240
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayHead.frx":0000
End
Begin VB.CommandButton cmdCalc
Caption = "Calc"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 11775
TabIndex = 75
TabStop = 0 'False
Top = 3765
Width = 615
End
Begin VB.TextBox txtTTLPay
Alignment = 1 'Right Justify
Height = 315
Left = 11355
TabIndex = 72
Top = 5370
Width = 990
End
Begin VB.TextBox txtTTLHrs
Alignment = 1 'Right Justify
Height = 315
Left = 11370
TabIndex = 71
Top = 4575
Width = 990
End
Begin VB.CommandButton cmdCertPR
Caption = "Cert. Pay Rates"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8220
TabIndex = 70
Top = 4095
Visible = 0 'False
Width = 1035
End
Begin VB.TextBox txtOTAmt
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 14
Top = 5025
Width = 990
End
Begin VB.TextBox txtGross
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 1
EndProperty
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 13
Top = 5025
Width = 990
End
Begin VB.TextBox txtTTLAmt
Alignment = 1 'Right Justify
Height = 315
Left = 9300
TabIndex = 15
Top = 5385
Width = 990
End
Begin VB.TextBox txtOTRate
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 12
Top = 4725
Width = 990
End
Begin VB.TextBox txtOTHrs
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 10
Top = 4425
Width = 990
End
Begin LpLib.fpList lstHouses
Height = 2400
Left = 60
TabIndex = 62
Top = 1185
Width = 3615
_Version = 196608
_ExtentX = 6376
_ExtentY = 4233
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 = 4
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= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayHead.frx":065E
End
Begin VB.TextBox txtPaint
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 11025
TabIndex = 60
Top = 420
Width = 690
End
Begin VB.CheckBox chkBiWeekly
BackColor = &H00C0FFFF&
Caption = "BiWeekly PR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 1935
TabIndex = 58
Top = 840
Visible = 0 'False
Width = 1575
End
Begin VB.TextBox txtStone
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 9240
TabIndex = 54
TabStop = 0 'False
Top = 420
Width = 690
End
Begin VB.CheckBox chkReady
Caption = "Ready to Process"
Height = 255
Left = 3825
TabIndex = 42
Top = 3585
Width = 1995
End
Begin VB.CheckBox chkDeduct
Caption = "Deductions"
Height = 255
Left = 150
TabIndex = 39
TabStop = 0 'False
Top = 5550
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdDivide
Caption = "Divide Equally"
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 = 5400
TabIndex = 38
TabStop = 0 'False
Top = 4080
Width = 1155
End
Begin VB.CommandButton cmdSavePay
Caption = "&Save Emp. Pay"
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 = 5400
TabIndex = 16
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdTotal
Caption = "Update &Totals"
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 = 6930
TabIndex = 27
TabStop = 0 'False
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdGetCrew
Caption = "Get &Crew 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 = 555
Left = 6930
TabIndex = 26
TabStop = 0 'False
Top = 4080
Width = 1155
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 = 3855
TabIndex = 25
TabStop = 0 'False
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdAddLot
Caption = "Add &House/PO"
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 = 3855
TabIndex = 17
TabStop = 0 'False
Top = 4080
Width = 1155
End
Begin VB.TextBox txtHRate
Alignment = 1 'Right Justify
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 11
Top = 4725
Width = 990
End
Begin VB.TextBox txtHours
Alignment = 1 'Right Justify
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 9
Top = 4425
Width = 990
End
Begin VB.TextBox txtPayDate
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 1200
TabIndex = 8
TabStop = 0 'False
Top = 60
Width = 1275
End
Begin VB.TextBox txtSumCrew
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 9600
TabIndex = 2
TabStop = 0 'False
Top = 60
Width = 975
End
Begin VB.TextBox txtSumHouse
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 7500
TabIndex = 1
TabStop = 0 'False
Top = 60
Width = 975
End
Begin VB.TextBox txtCrewID
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 3180
TabIndex = 0
TabStop = 0 'False
Top = 60
Width = 615
End
Begin VB.ListBox lstLots
Height = 1620
Left = 3780
Sorted = -1 'True
TabIndex = 28
TabStop = 0 'False
Top = 1200
Visible = 0 'False
Width = 4335
End
Begin LpLib.fpList lstCrew
Height = 2415
Left = 8220
TabIndex = 61
Top = 1170
Width = 3900
_Version = 196608
_ExtentX = 6879
_ExtentY = 4260
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 = 4
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= 210
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayHead.frx":0BC8
End
Begin MSComCtl2.DTPicker dtpPayDate
Height = 315
Left = 6900
TabIndex = 83
Top = 5265
Width = 1215
_ExtentX = 2143
_ExtentY = 556
_Version = 393216
Format = 89915393
CurrentDate = 43678
MaxDate = 55153
MinDate = 36892
End
Begin VB.Label lblTEST
Height = 285
Left = 6915
TabIndex = 87
Top = 5580
Width = 1170
End
Begin VB.Label lblTYPE3
Caption = "TYPE FROM PayList"
Height = 435
Left = 30
TabIndex = 82
Top = 4950
Visible = 0 'False
Width = 555
End
Begin VB.Label lblWorkDone
Caption = "WORKDONE"
Height = 195
Left = 3915
TabIndex = 81
Top = 2925
Visible = 0 'False
Width = 255
End
Begin VB.Label lblTYPE2
Caption = "CrewTYpe"
Height = 225
Left = 3015
TabIndex = 80
Top = 3705
Visible = 0 'False
Width = 435
End
Begin VB.Label lblLOTID
Caption = "LOT"
Height = 195
Left = 7500
TabIndex = 79
Top = 3240
Visible = 0 'False
Width = 615
End
Begin VB.Label lblPROJID
Caption = "PRJ"
Height = 225
Left = 7470
TabIndex = 78
Top = 2940
Visible = 0 'False
Width = 585
End
Begin VB.Label lblCalcHrs
Height = 270
Left = 11400
TabIndex = 76
Top = 4200
Visible = 0 'False
Width = 225
End
Begin VB.Label lblTTLDlrs
Alignment = 2 'Center
Caption = "Total Pay"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 11715
TabIndex = 74
Top = 4905
Width = 555
End
Begin VB.Label lblTTLHrs
Alignment = 2 'Center
Caption = "Total Hours"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 11580
TabIndex = 73
Top = 4185
Width = 690
End
Begin VB.Label lblCertPR
Alignment = 2 'Center
BackColor = &H0080FFFF&
Caption = "CERTIFIED"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 300
Left = 9615
TabIndex = 69
Top = 825
Visible = 0 'False
Width = 2505
End
Begin VB.Label lblNoCalc
BackColor = &H0080FFFF&
Caption = "NO CALC"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 180
Left = 8280
TabIndex = 68
Top = 3600
Visible = 0 'False
Width = 855
End
Begin VB.Label lblTIE
Caption = "TIEBREAKER"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 180
Left = 9255
TabIndex = 67
Top = 3600
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblTTLWage
AutoSize = -1 'True
Caption = "Total Wages:"
Height = 195
Left = 8235
TabIndex = 66
Top = 5490
Width = 960
End
Begin VB.Label lblRegTime
Alignment = 2 'Center
Caption = "Reg Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 9330
TabIndex = 65
Top = 4170
Width = 945
End
Begin VB.Label lblOTTime
Alignment = 2 'Center
Caption = "OT Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 10365
TabIndex = 64
Top = 4185
Width = 945
End
Begin VB.Label lblCtrl
Alignment = 2 'Center
Caption = "CTRL-K to LOOK"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 45
TabIndex = 63
Top = 3600
Visible = 0 'False
Width = 2610
End
Begin VB.Label lblPaint
AutoSize = -1 'True
Caption = "Paint SqFt:"
Height = 195
Left = 10110
TabIndex = 59
Top = 480
Width = 780
End
Begin VB.Label lblFrameCnt
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 = 255
Left = 1740
TabIndex = 57
Top = 5310
Width = 675
End
Begin VB.Label lblFrames
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Frames:"
Height = 195
Left = 1125
TabIndex = 56
Top = 5310
Width = 555
End
Begin VB.Label lblWCCode
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Height = 315
Left = 10365
TabIndex = 55
Top = 5370
Width = 990
End
Begin VB.Label lblStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone SqFt:"
Height = 195
Left = 8355
TabIndex = 53
Top = 480
Width = 840
End
Begin VB.Label lblMRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 6705
TabIndex = 52
Top = 480
Width = 825
End
Begin VB.Label lblDMRate
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 7605
TabIndex = 51
Top = 420
Width = 690
End
Begin VB.Label lblDRate2
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5925
TabIndex = 50
Top = 420
Width = 690
End
Begin VB.Label lblDRate
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5220
TabIndex = 49
Top = 420
Width = 690
End
Begin VB.Label lblRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Rates:"
Height = 195
Left = 4320
TabIndex = 48
Top = 480
Width = 780
End
Begin VB.Label lblDMetal
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 3180
TabIndex = 47
Top = 420
Width = 1035
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal:"
Height = 195
Left = 2670
TabIndex = 46
Top = 480
Width = 435
End
Begin VB.Label lblDFin2
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1680
TabIndex = 45
Top = 420
Width = 795
End
Begin VB.Label lblDYds
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 600
TabIndex = 44
Top = 420
Width = 1035
End
Begin VB.Label lblYds
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Yds:"
Height = 195
Left = 240
TabIndex = 43
Top = 480
Width = 315
End
Begin VB.Label lblSelect
Alignment = 2 'Center
Caption = "CTRL-S to Select Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 195
Left = 6240
TabIndex = 41
Top = 3720
Visible = 0 'False
Width = 1935
End
Begin VB.Label lblTerm
Caption = "TERMINATED"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 180
Left = 10590
TabIndex = 40
Top = 3600
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblBalance
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3780
TabIndex = 37
Top = 840
Width = 4335
End
Begin VB.Label lblDelete
Caption = "CTRL R to Delete Crews CTRL H to Delete Houses"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = 4950
TabIndex = 36
Top = 2985
Width = 2295
End
Begin VB.Label lblDifference
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
ForeColor = &H00000000&
Height = 315
Left = 10680
TabIndex = 35
Top = 60
Width = 1155
End
Begin VB.Label lblBC
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2700
TabIndex = 34
Top = 4110
Width = 915
End
Begin VB.Label lblPayAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Amount:"
Height = 195
Left = 780
TabIndex = 33
Top = 4950
Width = 900
End
Begin VB.Label lblType
BorderStyle = 1 'Fixed Single
Height = 315
Left = 960
TabIndex = 32
Top = 4080
Width = 1695
End
Begin VB.Label lblCrewType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Type:"
Height = 195
Left = 120
TabIndex = 31
Top = 4155
Width = 810
End
Begin VB.Label lblPay
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 = 255
Left = 1740
TabIndex = 30
Top = 4950
Width = 1875
End
Begin VB.Label lblAddress
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 = 315
Left = 0
TabIndex = 29
Top = 4470
Width = 3615
End
Begin VB.Label lblGross
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Amount:"
Height = 195
Left = 8295
TabIndex = 24
Top = 5145
Width = 900
End
Begin VB.Label lblHRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Hourly Rate:"
Height = 195
Left = 8310
TabIndex = 23
Top = 4845
Width = 885
End
Begin VB.Label lblHours
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "# of Hours:"
Height = 195
Left = 8400
TabIndex = 22
Top = 4545
Width = 795
End
Begin VB.Label lblEmpName
BorderStyle = 1 'Fixed Single
Height = 315
Left = 9165
TabIndex = 21
Top = 3780
Width = 2505
End
Begin VB.Label lblEmpId
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8220
TabIndex = 20
Top = 3780
Width = 915
End
Begin VB.Label lblCrewMember
AutoSize = -1 'True
Caption = "Crew Workers"
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 = 8280
TabIndex = 19
Top = 900
Width = 1200
End
Begin VB.Label lblHouse
AutoSize = -1 'True
Caption = "Houses && POs"
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 = 120
TabIndex = 18
Top = 900
Width = 1215
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 0
X2 = 11880
Y1 = 780
Y2 = 780
End
Begin VB.Label lblPayDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payroll Date:"
Height = 195
Left = 225
TabIndex = 7
Top = 120
Width = 900
End
Begin VB.Label lblCrewName
BorderStyle = 1 'Fixed Single
Height = 315
Left = 3840
TabIndex = 6
Top = 60
Width = 2595
End
Begin VB.Label lblSumCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Workers Sum:"
Height = 195
Left = 8520
TabIndex = 5
Top = 120
Width = 1005
End
Begin VB.Label lblSumHouse
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Houses Sum:"
Height = 195
Left = 6480
TabIndex = 4
Top = 120
Width = 945
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 2700
TabIndex = 3
Top = 120
Width = 405
End
End
Attribute VB_Name = "frmPayHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mboolDelete As Boolean, mboolCERTIFIED As Boolean, mboolAdding As Boolean
Dim moRSPay As Recordset, moRSTIME As Recordset, mboolNOYDS As Boolean
Dim moRSCREW As Recordset, moRS As Recordset, moRSSPS As Recordset
Dim moRSHEAD As Recordset, moRSPS As Recordset, mintYDS As Integer
Dim mdblHours As Double, mdblRate As Double, mdblGROSS As Double
Dim mdblOTHours As Double, mdblOTRate As Double, mdblOTGROSS As Double
Dim mbytCOUNT As Byte, mlngPSPAYID As Long, mstrTexture As String
Dim mstrWTYPE As String, mstrWDone As String
Private Sub cmdAddLot2_Click()
Dim strProj As String, strSQL As String, intPROJ As Integer
Dim strLine As String, intYN As Integer
Dim oRS As Recordset, oRSS As Recordset, oRS2 As Recordset
Dim strPSheet As String, oRSPS As Recordset, lngLOTID As Long
Dim strPCODE As String, strLOTNO As String, strPRJLOT As String, lngPROJID As Long
Dim sglMETAL As Single, sglPAMT As Single, strPROJCODE As String
intYN = MsgBox("Do You Want To See A List Of Pay Sheets For This Crew?", vbYesNo, "Pay Sheet List?")
If intYN = vbYes Then
strPSheet = "SELECT * FROM tblPAYSHEET WHERE Not PAID and CrewID = " & gintCREWID
Set oRSPS = New Recordset
oRSPS.Open strPSheet, goConn, adOpenDynamic, adLockOptimistic
If oRSPS.EOF Then
MsgBox "No Pay Sheets Were Found For This Crew.", vbOKOnly, "No Paysheets"
Exit Sub
Else
Do Until oRSPS.EOF
lstPaySheets.Clear
lstPaySheets.Top = 1200
lstPaySheets.Left = 3780
lstPaySheets.Height = 2400
lstPaySheets.Width = 4335
lstPaySheets.Visible = True
lngLOTID = Field2Str2(oRSPS!lotid)
strSQL = "SELECT PROJ_ID, LOT_NO FROM tblLOTINFO WHERE Lot_ID = " & lngLOTID
Set oRS2 = New Recordset
oRS2.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS2.EOF Then
lngPROJID = Field2Str(oRS2!PROJ_ID)
strLOTNO = Field2Str(oRS2!lot_no)
oRS2.Close
Else
MsgBox "No Lot Information Found", vbOKOnly, "No Lot"
End If
strSQL = "SELECT Proj_Code FROM tblPROJECT WHERE Proj_ID = " & lngPROJID
Set oRS2 = New Recordset
oRS2.Open strSQL, goConn, adOpenDynamic, adLockBatchOptimistic
If Not oRS2.EOF Then
strPROJCODE = Field2Str(oRS2!Proj_Code)
oRS.Close
Else
MsgBox "No Project Found", vbOKOnly, "No Project"
Exit Sub
End If
strPRJLOT = Trim(strPROJCODE) & " - " & Trim(strLOTNO)
strLine = Field2Str2(oRSPS!pay_id) & vbTab & strPRJLOT & vbTab & Field2Str(oRSPS!Type)
strLine = strLine & vbTab & Field2Str(oRSPS!WorkDone) & vbTab & Field2Str2(oRSPS!pay_ydge) & vbTab & Field2Str2(oRSPS!GROSSPAY)
lstPaySheets.AddItem strLine
Loop
End If
ElseIf intYN = vbNo Then
strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code")
If Len(strProj) > 0 Then
strProj = UCase(strProj)
strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
frmProjList.txtSearch = strProj
frmProjList.Show 1
Else
gintPROJID = Field2Long(oRS!PROJ_ID)
End If
strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lstLots.Clear
lstLots.Top = 1200
lstLots.Left = 3780
lstLots.Height = 2400
lstLots.Width = 4335
lstLots.Visible = True
Do Until oRSS.EOF
With lstLots
strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address)
.AddItem strLine
.ItemData(.NewIndex) = oRSS!Lot_ID
End With
oRSS.MoveNext
Loop
If lstLots.ListCount Then
lblSelect.Visible = True
lblCtrl.Visible = True
lstLots.ListIndex = 0
End If
lstLots.SetFocus
Else
MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code"
cmdAddLot.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub cmd1Emp_Click()
Dim strSQL As String, strEMPID As String, dtPAYDT As String
Dim oRS As Recordset
Dim sglRTWages, sglOTWages As Single, strCODES As String
On Error GoTo Error_EH
lstCrew.col = 1
strEMPID = lstCrew.ColText
' strSQL = "SELECT * FROM tblHOURLIST WHERE PAY_DATE = #" & dtpPayDate.Value & "#"
strSQL = "SELECT * FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & dtpPayDate.Value & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
strCODES = Field2Str(oRS!CODES)
If strCODES = "1" Then
txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2))
txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2))
txtHRate = Format(CSng(Field2Str(oRS!Rate)), "#,#.00") '+ CSng(Field2Str(oRS!Reg_RT2))) / 2
txtOTRate = Format(CSng(Field2Str(oRS!OT_Rate)), "#,#.00") ' + CSng(Field2Str(oRS!OT_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
' sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2)))))
txtGross = Format(sglRTWages, "#,#.00")
txtOTAmt = Format(sglOTWages, "#,#.00")
txtTTLAmt = sglOTWages + sglRTWages
txtTTLAmt = Format(txtTTLAmt, "#,#.00")
ElseIf strCODES = "2" Then
txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2))
txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2))
If Field2Str2(oRS!Reg_RT2) > 0 Then
txtHRate = (CSng(Field2Str(oRS!Rate)) + CSng(Field2Str(oRS!Reg_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_HRS2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
Else
txtHRate = CSng(Field2Str(oRS!Rate)) ' + CSng(Field2Str(oRS!Reg_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
End If
If Field2Str2(oRS!OT_RT2) > 0 Then
txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2)))))
Else
txtOTRate = CSng(Field2Str(oRS!OT_Rate)) ' + CSng(Field2Str(oRS!OT_RT2))) / 2
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
End If
' txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2
' sglRTWages = (CSng(Field2Str(oRS!Reg_Hrs)) * (CSng(Field2Str(oRS!Rate))))
' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
txtGross = Format(sglRTWages, "#,#.00")
txtOTAmt = Format(sglOTWages, "#,#.00")
txtTTLAmt = sglOTWages + sglRTWages
txtTTLAmt = Format(txtTTLAmt, "#,#.00")
End If
Else
MsgBox "No Employee Time Information Found", vbOKOnly, "No Time"
End If
Call CrewSave
cmdSavePay.Enabled = False
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmd1Emp_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAddLot_Click()
Dim strProj As String, strSQL As String, intPROJ As Integer
Dim strLine As String, intYN As Integer
Dim oRS As Recordset, oRSS As Recordset, oRS2 As Recordset
Dim strPSheet As String, oRSPS As Recordset, lngLOTID As Long, dblGPAY As Double
Dim strPCODE As String, strLOTNO As String, strPRJLOT As String, lngPROJID As Long
intYN = MsgBox("Do You Want To See A List Of Pay Sheets For This Crew?", vbYesNo, "Pay Sheet List?")
' intYN = vbNo
If intYN = vbYes Then
strPSheet = "SELECT * FROM tblPAYSHEET WHERE Not PAID and not MOVEPAY and CrewID = " & gintCREWID
Set oRSPS = New Recordset
oRSPS.Open strPSheet, goConn, adOpenDynamic, adLockOptimistic
If oRSPS.EOF Then
MsgBox "No Pay Sheets Were Found For This Crew.", vbOKOnly, "No Paysheets"
Exit Sub
Else
' Do Until oRSPS.EOF '*** This when testing
lstPaySheets.Clear
lstPaySheets.Top = 1200
lstPaySheets.Left = 3780
lstPaySheets.Height = 2400
lstPaySheets.Width = 4335
lstPaySheets.Visible = True
Do Until oRSPS.EOF
lngLOTID = Field2Str2(oRSPS!lotid)
strSQL = "SELECT PROJ_ID, LOT_NO FROM tblLOTINFO WHERE Lot_ID = " & lngLOTID
Set oRS2 = New Recordset
oRS2.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS2.EOF Then
lngPROJID = Field2Str(oRS2!PROJ_ID)
strLOTNO = Field2Str(oRS2!lot_no)
oRS2.Close
Else
MsgBox "No Lot Information Found", vbOKOnly, "No Lot"
End If
strSQL = "SELECT Proj_Code FROM tblPROJECT WHERE Proj_ID = " & lngPROJID
Set oRS2 = New Recordset
oRS2.Open strSQL, goConn, adOpenDynamic, adLockBatchOptimistic
If Not oRS2.EOF Then
strPCODE = Field2Str(oRS2!Proj_Code) '************ Check this to make sure it works
oRS2.Close
Else
MsgBox "No Project Found", vbOKOnly, "No Project"
Exit Sub
End If
If oRSPS!Amt = 0 Then
dblGPAY = (oRSPS!pay_ydge * oRSPS!Y_Rate) + (oRSPS!METAL * oRSPS!M_Rate)
If dblGPAY > 0 Then
oRSPS!Amt = dblGPAY
oRSPS!GROSSPAY = dblGPAY
oRSPS.Update
End If
End If
strPRJLOT = Trim(strPCODE) & " - " & Trim(strLOTNO)
strLine = Field2Str2(oRSPS!payid) & vbTab & strPRJLOT & vbTab & Field2Str(oRSPS!Type)
strLine = strLine & vbTab & Field2Str(oRSPS!worktype) & vbTab & Field2Str(oRSPS!pay_ydge)
strLine = strLine & vbTab & Format(Field2Str2(oRSPS!GROSSPAY), "#,#.00") 'Change to GrossPay when for Final
strLine = strLine & vbTab & Field2Str(lngPROJID) & vbTab & Field2Str(lngLOTID)
' strLine = strLine & vbTab & Field2Str(oRSPS!worktype) & vbTab & Field2Str(oRSPS!pay_ydge) & vbTab & Field2Str2(oRSPS!Amt) 'Change to GrossPay when for Final
lstPaySheets.AddItem strLine
oRSPS.MoveNext
Loop
End If
ElseIf intYN = vbNo Then
strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code")
If Len(strProj) > 0 Then
strProj = UCase(strProj)
strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
frmProjList.txtSearch = strProj
frmProjList.Show 1
Else
gintPROJID = Field2Long(oRS!PROJ_ID)
End If
strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lstLots.Clear
lstLots.Top = 1200
lstLots.Left = 3780
lstLots.Height = 2400
lstLots.Width = 4335
lstLots.Visible = True
Do Until oRSS.EOF
With lstLots
strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address)
.AddItem strLine
.ItemData(.NewIndex) = oRSS!Lot_ID
End With
oRSS.MoveNext
Loop
If lstLots.ListCount Then
lblSelect.Visible = True
lblCtrl.Visible = True
lstLots.ListIndex = 0
End If
lstLots.SetFocus
Else
MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code"
cmdAddLot.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub cmdDetail_Click() ' Not Used
gintPROJID = moRSPay!PROJ_ID
gintLOTID = moRSPay!Lot_ID
Call ViewPayInfo
End Sub
Private Sub cmdAllCrew_Click()
Dim strSQL As String, strEMPID As String, dtPAYDT As String
Dim oRS As Recordset
Dim intCREWCNT As Integer, intCOUNT As Integer
Dim sglRTWages, sglOTWages As Single, strCODES As String
On Error GoTo Error_EH
intCOUNT = 0
intCREWCNT = lstCrew.ListCount
Do Until intCOUNT = intCREWCNT ' - 1
lstCrew.col = 1
strEMPID = lstCrew.ColText
' strSQL = "SELECT * FROM tblHOURLIST WHERE PAY_DATE = #" & dtpPayDate.Value & "#"
strSQL = "SELECT * FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & dtpPayDate.Value & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
strCODES = Field2Str(oRS!CODES)
If strCODES = "1" Then
txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2))
txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2))
txtHRate = Format(CSng(Field2Str(oRS!Rate)), "#,#.00") '+ CSng(Field2Str(oRS!Reg_RT2))) / 2
txtOTRate = Format(CSng(Field2Str(oRS!OT_Rate)), "#,#.00") ' + CSng(Field2Str(oRS!OT_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
' sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2)))))
txtGross = Format(sglRTWages, "#,#.00")
txtOTAmt = Format(sglOTWages, "#,#.00")
txtTTLAmt = sglOTWages + sglRTWages
txtTTLAmt = Format(txtTTLAmt, "#,#.00")
ElseIf strCODES = "2" Then
txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2))
txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2))
If Field2Str2(oRS!Reg_RT2) > 0 Then
txtHRate = (CSng(Field2Str(oRS!Rate)) + CSng(Field2Str(oRS!Reg_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_HRS2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
Else
txtHRate = CSng(Field2Str(oRS!Rate)) ' + CSng(Field2Str(oRS!Reg_RT2))) / 2
sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate))))
End If
If Field2Str2(oRS!OT_RT2) > 0 Then
txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2)))))
Else
txtOTRate = CSng(Field2Str(oRS!OT_Rate)) ' + CSng(Field2Str(oRS!OT_RT2))) / 2
sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate))))
End If
' txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2
' sglRTWages = (CSng(Field2Str(oRS!Reg_Hrs)) * (CSng(Field2Str(oRS!Rate))))
' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2)))))
txtGross = Format(sglRTWages, "#,#.00")
txtOTAmt = Format(sglOTWages, "#,#.00")
txtTTLAmt = sglOTWages + sglRTWages
txtTTLAmt = Format(txtTTLAmt, "#,#.00")
End If
Else
MsgBox "No Employee Time Information Found", vbOKOnly, "No Time"
End If
Call CrewSave
lstCrew.ListIndex = lstCrew.ListIndex + 1
intCOUNT = intCOUNT + 1
Loop
cmdSavePay.Enabled = False
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmd1Emp_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdCalc_Click()
Call CalcWages
End Sub
Private Sub cmdCertPR_Click()
frmCertified.Show 1
End Sub
Private Sub cmdDivide_Click()
Dim dblPay As Double, intCOUNT As Integer, intZERO As Integer
Dim strSQL As String, strMSG As String, strSELECT As String
Dim oRS As Recordset, strPCID As String
On Error GoTo Error_EH
If mbytCOUNT = 0 Then
strMSG = "There Are No Crew Workers Shown, This Will Cause An Error"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Exit Payroll and Add The Workers For This Crew!"
MsgBox strMSG, vbOKOnly, "Enter Crew Members"
Exit Sub
End If
strSELECT = "SELECT COUNT(pay_id) as cntPAY FROM tblPAYCREW WHERE gross = 0 and pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intZERO = Field2Integer(oRS!cntpay)
If intZERO > 0 Then
dblPay = Round((Field2Str2(lblDifference.Caption) / intZERO), 2)
intCOUNT = 1
Do Until intCOUNT > mbytCOUNT
lstCrew.ListIndex = intCOUNT - 1
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "SELECT * FROM tblPayCrew WHERE pc_Id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Field2Str2(moRSCREW!gross) = 0 Then
If Field2Str2(moRSCREW!hours) = 0 Then
If Field2Str2(dblPay) < 120 Then
moRSCREW!hours = 10
ElseIf Field2Str2(dblPay) < 240 Then
moRSCREW!hours = 20
ElseIf Field2Str2(dblPay) < 360 Then
moRSCREW!hours = 30
' ElseIf Field2Str2(dblPay) < 480 Then
' moRSCREW!hours = 60
Else
moRSCREW!hours = 40
End If
End If
moRSCREW!gross = Field2Str2(dblPay)
moRSCREW!REG_WAGE = Field2Str2(dblPay)
moRSCREW!Rate = Format((Field2Str2(moRSCREW!gross) / Field2Str2(moRSCREW!hours)), "#0.00##")
moRSCREW.Update
End If
intCOUNT = intCOUNT + 1
Loop
End If
Call CrewLoad
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmdDivide_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdGetCrew_Click()
Call GetCrew
End Sub
Private Sub ClearCrew()
Dim strSQL As String, oRS As Recordset, intCNTC As Integer, intALLC As Integer
Dim lngCrewID As Integer, boolDONE As Boolean, strCrewID As String
boolDONE = False
intCNTC = 1
intALLC = lstCrew.ListCount
lstCrew.ListIndex = 0
Do Until boolDONE
lstCrew.col = 0
strCrewID = Format(Field2Str2(lstCrew.ColText), "######")
strSQL = "SELECT * FROM tblPAYCREW WHERE PC_ID = " & strCrewID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!INCLUDE = vbFalse
oRS.Update
oRS.Close
End If
If intCNTC = intALLC Then
boolDONE = True
intCNTC = 1
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = intCNTC
intCNTC = intCNTC + 1
End If
Loop
Call CrewLoad
End Sub
Private Sub ClearHouse()
Dim strSQL As String, oRS As Recordset, intCNTH As Integer, intALLH As Integer
Dim lngPAYID As Integer, boolDONE As Boolean, strPAYID As String
boolDONE = False
intCNTH = 1
intALLH = lstHouses.ListCount
lstHouses.ListIndex = 0
Do Until boolDONE
lstHouses.col = 0
strPAYID = Format(Field2Str2(lstHouses.ColText), "######")
strSQL = "SELECT * FROM tbltime WHERE IDNUM = " & strPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!INCLUDE = vbFalse
oRS.Update
oRS.Close
End If
If intCNTH = intALLH Then
boolDONE = True
intCNTH = 1
lstHouses.ListIndex = 0
Else
lstHouses.ListIndex = intCNTH
intCNTH = intCNTH + 1
End If
Loop
Call PayLoad
End Sub
Private Sub cmdMoveHouse_Click()
Dim bytCOUNT As Byte, sglPerHouse As Single, strID As String
Dim intCOUNT As Integer, oRS As Recordset, strSQL As String
intCOUNT = 0
bytCOUNT = lstHouses.ListCount
sglPerHouse = CSng(txtSumCrew) / bytCOUNT
lstHouses.ListIndex = 0
Do Until intCOUNT = lstHouses.ListCount
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If Not oRS.EOF Then
oRS!pay_amt = sglPerHouse
oRS.Update
End If
lstHouses.ListIndex = lstHouses.ListIndex + 1
intCOUNT = intCOUNT + 1
Loop
Call cmdTotal_Click
End Sub
Private Sub cmdPaySheet_Click()
End Sub
Private Sub cmdSavePay_Click()
Call CrewSave
cmdSavePay.Enabled = False
Call cmdTotal_Click
lstCrew.SetFocus
End Sub
Private Sub cmdTest_Click()
frmProjList.Show 1
End Sub
Private Sub cmdTotal_Click()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT sum(pay_amt) as SumHouse FROM tblTime where pay_id = " & gintPAYID & " and crew = " & gintCREWID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
txtSumHouse = Format(Field2Str2(oRS!SumHouse), "##,###.00")
End If
strSQL = "SELECT sum(gross) as SumWorker FROM tblpaycrew where pay_id = " & gintPAYID & " and crew_id = " & gintCREWID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
txtSumCrew = Format(Field2Str2(oRS!SumWorker), "##,###.00")
End If
lblDifference.Caption = Format(Field2Str2(txtSumHouse) - Field2Str2(txtSumCrew), "##,##0.00;(##,##0.00)")
If Field2Str2(lblDifference.Caption) < 0 Then
lblDifference.ForeColor = &HFF&
lblBalance.Caption = "Crew Greater Than Houses"
ElseIf Field2Str2(lblDifference.Caption) > 0 Then
lblDifference.ForeColor = &H0&
lblBalance.Caption = "Houses Greater Than Crew"
Else
lblDifference.ForeColor = &H0&
lblBalance.Caption = "Payroll is Balanced"
End If
Call UpCrewPS
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmdTotal_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub UpCrewPS()
Dim strSQL As String, oRS As Recordset, lngTIMEID As Long
Dim strSQL1 As String, strSql2 As String, strSQL3 As String
Dim strFIXTYPE As String, strFIXWORKDONE As String
lstHouses.col = 0
lngTIMEID = Field2Long(lstHouses.ColText)
If lblWorkDone = "A" Then
strFIXTYPE = "W"
strFIXWORKDONE = "C"
lblWorkDone = strFIXWORKDONE
lblTYPE2 = strFIXTYPE
If lblTYPE2 = "" Then
lblTYPE2 = lblTYPE3
End If
End If
If txtCrewId <> "" Then
strSQL = "SELECT * FROM tblPaySheet WHERE LotID = " & Field2Long(lblLotId)
' strSQL1 = " AND CrewID = " & Field2Long(txtCrewId)
' strSQL = strSQL & " and TYPE = '" & strFIXTYPE & "' AND WORKTYPE = '" & strFIXWORKDONE & "'"
strSQL = strSQL & " and TYPE = '" & lblTYPE2 & "' AND WORKTYPE = '" & lblWorkDone & "'"
' strSQL = "SELECT * FROM tblPaySheet WHERE LotID = 42471" '& Field2Long(lblLOTID)
' strSQL1 = " AND CrewID = 419" ' & Field2Long(txtCrewId)
' strSQL2 = " and TYPE = 'W' AND WORKTYPE = 'C'"
' strSQL3 = strSQL & strSQL2
' strSQL3 = strSQL & strSQL1 & strSQL2
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not mboolDelete Then
If Not oRS.EOF Then
oRS!timeid = lngTIMEID
oRS!crewID = Field2Long(txtCrewId)
oRS!paid = vbTrue
oRS.Update
End If
Else
mboolDelete = False
End If
End If
End Sub
Private Sub cmdLook_Click()
gintPROJID = moRSPay!PROJ_ID
gintLOTID = moRSPay!Lot_ID
Load frmPayroll
' frmPayroll.mboolLOOK = vbTrue
frmPayroll.chkLOOK = vbChecked
' cmdLook.Visible = False
' cmdDetail.Visible = False
frmPayroll.Show 1
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
mboolDelete = False
' If chkBiWeekly = True Then
' chkBiWeekly.Visible = True
' Else
' chkBiWeekly.Visible = False
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim intLOC As Integer, strWCCODE As String, lngID As Long
Dim oRS As Recordset, strSQL As String
' *** CtrlA - Set record for NoCalcuations - All calculations will have be be done manually
' *** CtrlH - Delete the highlighted house
' *** CtrlR - Delete the highlighted crew
' *** CtrlS - Select The Higlighted Lot in lstLots
' *** CtrlT - Add the Out of Balance Amount to the Highlighted Crew Member
' *** CtrlK - View the payroll information for the Highlighted House
' *** CtrlQ - Fix the WC code for the highlighted crew member
' *** CtrlD - Mark The Highlighted Pay Sheet as Paid
' *** CtrlY - Fix TIME yardage for hi-lited house
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 = vbKeyH Then ' Display key combinations.
If CtrlDown Then
Call HouseDelete
Call PayLoad
Call cmdTotal_Click
' txtHours.SetFocus
If txtHours = "" Or IsNull(txtHours) Then
txtHours = 0
End If
End If
Exit Sub
End If
If KeyCode = vbKeyR Then ' Display key combinations.
If CtrlDown Then
Call CrewDelete
Call CrewLoad
Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyS Then ' Display key combinations.
If CtrlDown Then
Call lstLots_DblClick
End If
Exit Sub
End If
If KeyCode = vbKeyY Then
If CtrlDown Then
End If
Exit Sub
End If
If KeyCode = vbKeyT Then ' Put the out of balance amount to this employee
If CtrlDown Then
Call BalancePay
End If
Exit Sub
End If
If KeyCode = vbKeyA Then ' Display key combinations.
If CtrlDown Then
Call NoCalc
End If
Exit Sub
End If
' If KeyCode = vbKeyF Then ' Display key combinations.
' If CtrlDown Then
' Call ViewPayInfo
' End If
' Exit Sub
' End If
If KeyCode = vbKeyK Then ' Display key combinations.
If CtrlDown Then
Call cmdLook_Click
End If
Exit Sub
End If
If KeyCode = vbKeyQ Then ' Fix The Project Code (WC Code) for the highlighted employee
If CtrlDown Then
intLOC = lstCrew.ListIndex
strWCCODE = InputBox("Enter The Correct WC Code", "WC Code", moRSCREW!wc_code)
moRSCREW!wc_code = strWCCODE
moRSCREW.Update
End If
Exit Sub
End If
' If KeyCode = vbKeyW Then ' Clear Marked Crew Members in lstCrew
' If CtrlDown Then
' Call ClearCrew
' End If
' Exit Sub
' End If
If KeyCode = vbKeyD Then ' Clear Marked Crew Members in lstCrew
If CtrlDown Then
If lstPaySheets.ListIndex > -1 Then
lstPaySheets.col = 0
lngID = Field2Long(lstPaySheets.ColText)
strSQL = "SELECT * FROM tblPaySheet WHERE PAYID = " & lngID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!paid = vbChecked
oRS.Update
End If
End If
End If
Exit Sub
End If
If KeyCode = vbKeyE Then ' Clear Marked Houses in lstHouses
If CtrlDown Then
If lstPaySheets.ListIndex > -1 Then
lstPaySheets.col = 0
lngID = Field2Long(lstPaySheets.ColText)
strSQL = "SELECT * FROM tblPaySheet WHERE PAYID = " & lngID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!invalid = vbChecked
oRS!movepay = vbChecked
oRS.Update
End If
End If
End If
Exit Sub
End If
End Sub
Private Sub NoCalc()
Dim strSQL As String
Dim oRS As Recordset
' On Error GoTo Error_EH
strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
oRS!NoCalc = vbTrue
Else
oRS!NoCalc = vbFalse
End If
End Sub
Private Sub BalancePay()
Dim dblGROSS As Double, dblDIFF As Double
dblDIFF = CDbl(lblDifference)
dblGROSS = Field2Str2(moRSCREW!gross)
If lblBalance.Caption = "Payroll is Balanced" Then
moRSCREW!tiebreak = vbFalse
moRSCREW.Update
Call CrewLoad
ElseIf lblBalance.Caption = "Crew Greater Than Houses" Then
dblGROSS = dblGROSS + dblDIFF
' dblGROSS = dblGROSS - dblDIFF
moRSCREW!REG_WAGE = dblGROSS
moRSCREW!gross = dblGROSS
' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) - Field2Str2(lblDifference)
moRSCREW!tiebreak = vbTrue
moRSCREW.Update
Call cmdTotal_Click
Call CrewLoad
ElseIf lblBalance.Caption = "Houses Greater Than Crew" Then
dblGROSS = dblGROSS + dblDIFF
' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) + Field2Str2(lblDifference)
moRSCREW!gross = dblGROSS
moRSCREW!REG_WAGE = dblGROSS
moRSCREW!tiebreak = vbTrue
moRSCREW.Update
Call cmdTotal_Click
Call CrewLoad
End If
End Sub
Private Sub ViewPayInfo()
Load frmPayInput
frmPayInput.chkLOOK = vbChecked
' cmdLook.Visible = False
' cmdDetail.Visible = False
frmPayInput.Show 1
End Sub
Private Sub CrewDelete()
Dim strSQL As String, strPCID As String
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "DELETE * FROM tblPayCrew where Pc_id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex)
goConn.Execute strSQL
End Sub
Private Sub HouseDelete()
Dim strSQL As String, strID As String
Call CheckScaf
mboolDelete = True
Call PaySheetUpdate
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "DELETE * FROM tblTime where idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
goConn.Execute strSQL
' mboolDelete = False
End Sub
Private Sub PaySheetUpdate()
Dim strSQL As String, strID As String
Dim oRS As Recordset
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
' oRS!crewID = 0
oRS!paid = False
' oRS!paid = vbUnchecked
oRS!timeid = 0
oRS!movepay = False
' oRS!movepay = vbNo
' oRS!Amt = 0
' oRS!Y_Rate = 0
' oRS!m_Rate = 0
oRS.Update
oRS.Close
End If
End Sub
Private Sub CheckScaf()
Dim strSQL As String, oRS As Recordset, strID As String
Dim strSQLL As String, oRSS As Recordset
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
If oRS!scafid Then
strSQLL = "SELECT * FROM tblSCAFFOLD WHERE scaf_id = " & Field2Long(oRS!scafid)
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
oRSS!paid = vbUnchecked
oRSS!pdamt = 0
' oRSS!prcrew = 0
oRSS.Update
oRSS.Close
End If
End If
End If
If oRS.State = adStateOpen Then
oRS.Close
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
lblCertPR.Visible = False
cmdCertPR.Visible = False
txtHours = 0
txtOTHrs = 0
txtHRate = 0
txtOTRate = 0
txtGross = 0
txtOTAmt = 0
txtTTLAmt = 0
mboolNOYDS = False
mintYDS = 0
frmPayHead.Width = 12495
' frmPayHead.Width = 12315
lstCrew.Width = 3900
Call GetWage
Call GetHeader
Call PayLoad
Call CrewLoad
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
Call FormShowCrew
End If
End If
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindPay() As Boolean
Dim strSQL As String, strID As String
On Error GoTo Error_EH
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
' strSQL = strSQL & "FROM tblTIME "
' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex)
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSPay.EOF Then
FormFindPay = False
Else
FormFindPay = True
lblProjId = Field2Str2(moRSPay!PROJ_ID)
lblLotId = Field2Str2(moRSPay!Lot_ID)
lblWorkDone = Field2Str(moRSPay!WorkDone)
' If moRSPay!certpr Then
' mboolCERTIFIED = True
' End If
End If
Exit Function
Error_EH:
gstrMODULE = "Form PayHead - Module FormFindPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindCrew() As Boolean
Dim strSQL As String, strPCID As String
On Error GoTo Error_EH
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPayCrew "
strSQL = strSQL & "WHERE Pc_Id = " & Field2Str2(strPCID)
' strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSCREW.EOF Then
FormFindCrew = False
Else
FormFindCrew = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form PayHead - Module FormFindCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindPS()
Dim strSQL As String, strPCID As String
On Error GoTo Error_EH
lstPaySheets.col = 0
mlngPSPAYID = Field2Long(lstPaySheets.ColText)
' strPCID = lstCrew.ColText
strSQL = "SELECT * FROM tblPaySheet WHERE PayId = " & mlngPSPAYID
' strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex)
Set moRSPS = New Recordset
moRSPS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSCREW.EOF Then
FormFindPS = False
Else
FormFindPS = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form PayHead - Module FormFindCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShowPay()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSC As Recordset
On Error GoTo Error_EH
With moRSPay
strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = " & Field2Str(!Lot_ID)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
lblAddress.Caption = Field2Str(oRS!address)
If !pay_type = "S" Then
lblDYds.Caption = Field2Str(oRS!s_yds)
lblDMetal.Caption = ""
lblDFin2.Caption = Field2Str2(oRS!fin2)
ElseIf !pay_type = "L" Or !pay_type = "W" Then
lblDYds.Caption = Field2Str(oRS!l_yds)
lblDMetal.Caption = Field2Str2(oRS!METAL)
lblDFin2.Caption = ""
ElseIf !pay_type = "V" Then
txtStone = Field2Str(oRS!ST_SQFT)
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
ElseIf !pay_type = "C" Then
lblYds = "Frames:"
lblDYds.Caption = Field2Str2(oRS!Scaf6)
lblDMetal.Caption = ""
' End If
lblDFin2.Caption = Field2Str2(oRS!scaf10)
lblFrames.Visible = True
lblFrameCnt.Visible = True
ElseIf !pay_type = "X" Then
txtPaint = Field2Str(oRS!PNT_SQFT)
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
Else
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
End If
End If
If mboolCERTIFIED Then
lblCertPR.Visible = True
cmdCertPR.Visible = True
' Else
' lblCertPR.Visible = False
End If
If Field2Str(!pay_type) = "S" Then
lblType.Caption = "STUCCO"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "L" Then
lblType.Caption = "LATH"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "V" Then
lblType.Caption = "V_STONE"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "R" Then
lblType.Caption = "REPAIR/PO"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "C" Then
lblType.Caption = "SCAFFOLD"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "X" Then
lblType.Caption = "PAINT"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "W" Then
lblType.Caption = "WRAP"
lblTYPE2 = Field2Str(!pay_type)
ElseIf Field2Str(!pay_type) = "Q" Then
lblType.Caption = "MISC"
lblTYPE2 = Field2Str(!pay_type)
End If
If lblTYPE2 = "" Then
lblTYPE2 = lblTYPE3
End If
If !bc Then
lblBC.Caption = "Back Chg"
ElseIf Field2Str(!WorkDone) = "W" Then
lblBC.Caption = "PO Work"
ElseIf Field2Str(!WorkDone) = "F" Then
lblBC.Caption = "Fence"
ElseIf Field2Str(!WorkDone) = "U" Then
lblBC.Caption = "CMU"
Else
lblBC.Caption = ""
End If
lblPay.Caption = Format(Field2Str2(!pay_amt), "##,##0.00;(##,##0.00)")
lblDRate.Caption = Field2Str2(!yd_rate)
lblDRate2.Caption = Field2Str2(!fin2_Rate)
lblDMRate.Caption = Field2Str2(!mtl_Rate)
lblFrameCnt = Field2Str2(!frames)
End With
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module FormShowPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowCrew()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
With moRSCREW
lblEmpId.Caption = Field2Str(!Emp_ID)
lblEmpName.Caption = Field2Str(!EmpName)
lblWCCode = Field2Str(!wc_code)
strSql2 = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & Field2Str2(!Emp_ID) & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenDynamic, adLockPessimistic
' oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
' oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSS!Terminated <> "A" Then
lblTerm.Visible = True
Else
lblTerm.Visible = False
End If
End If
txtHRate = Format(Field2Str2(!Rate), "#0.00##")
txtHours = Format(Field2Str2(!hours), "#0.0#")
txtGross = Format(Field2Str2(!REG_WAGE), "##,##0.00")
txtOTRate = Format(Field2Str2(!OT_Rate), "#0.00##")
txtOTHrs = Format(Field2Str2(!OT_Hours), "#0.0#")
txtOTAmt = Format(Field2Str2(!OT_Wage), "##,##0.00")
txtTTLAmt = Format(Field2Str2(!gross), "##,##0.00")
txtTTLHrs = Field2Str2(!TTLHrs)
txtTTLPay = Format(Field2Str2(!TTLPay), "#,##0.00##")
If Field2Str(!autodeduct) = "Y" Then
chkDeduct = vbChecked
Else
chkDeduct = vbUnchecked
End If
If !tiebreak Then
lblTIE.Visible = True
Else
lblTIE.Visible = False
End If
End With
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module FormShowCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetPay()
Dim strSQL As String, strID As String
lstPaySheets.col = 0
strID = lstPaySheets.ColText
strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
' strSQL = strSQL & "FROM tblTIME "
' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex)
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSPay.EOF Then
End If
End Sub
Private Sub GetHRS()
Dim strSQL As String, strID As String
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
' strSQL = strSQL & "FROM tblTIME "
' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex)
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If Not moRSPay.EOF Then
If Field2Str2(moRSPay!pay_type) = "S" Or Field2Str2(moRSPay!pay_type) = "L" Then
If Field2Str2(moRSPay!yds) = 0 Then
moRSPay!yds = CInt(lblDYds)
moRSPay.Update
End If
End If
End If
End Sub
Private Sub GetPS()
Dim strSQL As String, strID As String
lstPaySheets.col = 0
strID = lstPaySheets.ColText
strSQL = "SELECT * FROM tblPAYSHEET WHERE PAYID = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
' strSQL = strSQL & "FROM tblTIME "
' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex)
Set moRSSPS = New Recordset
moRSSPS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSSPS.EOF Then
End If
End Sub
Private Sub GetCrew()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strCREW As String
On Error GoTo Error_EH
strCREW = "SELECT * FROM tblPayCrew WHERE pc_id = 1"
Set oRSS = New Recordset
oRSS.Open strCREW, goConn, adOpenForwardOnly, adLockOptimistic
strSQL = "SELECT * FROM tblCrewList WHERE crew_id = " & Str2Field(txtCrewId)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "No Workers Were Found For The Highlited Crew. Exit and Enter the Workers", vbOKOnly, "Workers Not Dound"
Exit Sub
End If
Do Until oRS.EOF
oRSS.AddNew
oRSS!pay_id = gintPAYID
oRSS!CREW_ID = Field2Str(oRS!CREW_ID)
oRSS!Emp_ID = Field2Str(oRS!Emp_ID)
oRSS!EmpName = Left(Field2Str(oRS!EmpName), 30)
oRSS!Pay_Date = Field2Str(txtPayDate)
oRSS!wc_code = Field2Str(oRS!wc_code)
oRSS.Update
oRS.MoveNext
Loop
Call CrewLoad
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Crew Member - This Member will not be saved", , "Duplicate Record"
Resume Next
' Exit Sub
End If
gstrMODULE = "Form PayHead - Module GetCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetHeader()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = " & gintPAYID
Set moRSHEAD = New Recordset
moRSHEAD.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
chkReady = Field2CheckBox(moRSHEAD!P_FLAG)
' chkReady = moRSHEAD!p_flag
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Crew List - This will not be saved", , "Duplicate Record"
Exit Sub
End If
gstrMODULE = "Form PayHead - Module CrewSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetWage()
Dim strSQL As String, oRS As Recordset
strSQL = "SELECT * FROM tblSYSInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
gsngWAGE = Field2Str2(oRS!WAGE)
End If
End Sub
Private Sub CrewSave()
On Error GoTo Error_EH
If moRSCREW.State = adStateClosed Then
Exit Sub
End If
With moRSCREW
!Rate = Str2Field(txtHRate.Text)
!hours = Str2Field(txtHours.Text)
!gross = Str2Field(txtTTLAmt.Text)
!OT_Wage = Str2Field(txtOTAmt.Text)
!REG_WAGE = Str2Field(txtGross.Text)
!OT_Hours = Str2Field(txtOTHrs.Text)
!OT_Rate = Str2Field(txtOTRate)
!TTLHrs = Str2Field(txtTTLHrs)
!TTLPay = Str2Field(txtTTLPay)
If chkDeduct Then
!autodeduct = "Y"
Else
!autodeduct = "N"
End If
End With
moRSCREW.Update
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetWorkType()
Dim strSQL As String, oRSW As Recordset
strSQL = "SELECT * FROM tblcboWorkType WHERE WTCode = '" & mstrWDone & "'"
Set oRSW = New Recordset
oRSW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSW.EOF Then
mstrWTYPE = Field2Str(oRSW!worktype)
End If
oRSW.Close
End Sub
Private Sub PayLoad()
Dim oRS As Recordset
Dim strSQL As String, strLOT As String, strY As String
Dim strLine As String, strWORK As String
'Add to New 11/15/17
On Error GoTo Error_EH
lblCertPR.Visible = False
cmdCertPR.Visible = False
strSQL = "SELECT * from tblTime WHERE Pay_id = " & gintPAYID
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHouses.Clear
Do Until moRSPay.EOF
If moRSPay!certpr Then
lblCertPR.Visible = True
cmdCertPR.Visible = True
End If
With lstHouses
mstrWDone = Field2Str(moRSPay!WorkDone)
If CInt(Field2Str2(moRSPay!yds)) > 0 Then
mintYDS = mintYDS + CInt(Field2Str2(moRSPay!yds))
Else
mboolNOYDS = True
End If
Call GetWorkType
strWORK = mstrWTYPE
If moRSPay!INCLUDE = vbTrue Then
strY = "Y"
Else
strY = ""
End If
' if morspay!
If moRSPay!bc Then
strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & "BACK CHARGE" & vbTab & strY
Else
strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & strWORK & vbTab & strY
End If
' ElseIf Field2Str(moRSPay!workdone) = "W" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PO WORK"
' ElseIf Field2Str(moRSPay!workdone) = "U" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "CMU"
' ElseIf Field2Str(moRSPay!workdone) = "A" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "TYPAR WRAP"
' ElseIf Field2Str(moRSPay!workdone) = "C" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "COMPLETE"
' ElseIf Field2Str(moRSPay!workdone) = "P" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PARTIAL"
' ElseIf Field2Str(moRSPay!workdone) = "F" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "FENCES"
' ElseIf Field2Str(moRSPay!workdone = "Y") Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "UP"
' ElseIf Field2Str(moRSPay!workdone = "Z") Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "DOWN"
' Else
' strLOT = Field2Str(moRSPay!proj_lot)
' End If
.AddItem strLOT
' .ItemData(.NewIndex) = Field2Long(moRSPay!idnum)
End With
moRSPay.MoveNext
Loop
' moRSPay.Close
If lstHouses.ListCount Then
lstHouses.ListIndex = 0
Else
lstHouses.ListIndex = -1
lblType.Caption = ""
lblAddress.Caption = ""
lblPay.Caption = ""
End If
lblTEST = mintYDS
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module PayLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim oRS As Recordset
Dim strSQL As String, strY As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
mbytCOUNT = 0
Do Until moRSCREW.EOF
With lstCrew
If moRSCREW!INCLUDE = vbTrue Then
strY = "Y"
Else
strY = ""
End If
strLine = Field2Str2(moRSCREW!pc_id) & vbTab & Field2Str(moRSCREW!Emp_ID) & vbTab & Field2Str(moRSCREW!EmpName) & vbTab & strY
.AddItem strLine
' .ItemData(.NewIndex) = moRSCREW!pc_id
End With
mbytCOUNT = Field2Str2(mbytCOUNT) + 1
moRSCREW.MoveNext
Loop
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = -1
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoadOld()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
mbytCOUNT = 0
Do Until moRSCREW.EOF
With lstCrew
strLine = Field2Str(moRSCREW!Emp_ID) & " " & Field2Str(moRSCREW!EmpName)
.AddItem strLine
.ItemData(.NewIndex) = moRSCREW!pc_id
End With
mbytCOUNT = Field2Str2(mbytCOUNT) + 1
moRSCREW.MoveNext
Loop
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = -1
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewLoadOld"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SavePay()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
oRS!sum_houses = Field2Str2(txtSumHouse)
oRS!sum_workers = Field2Str2(txtSumCrew)
oRS!P_FLAG = chkReady
oRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module SavePay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
Call SavePay
If cmdSavePay.Enabled Then
strMSG = "Employee Pay Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call CrewSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
If Field2Str2(lblDifference.Caption) <> 0 Then
strMSG = "The Payroll Is Not Balanced"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Are You Sure You Want To Exit ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNo, "PAYROLL UNBALANCED")
Select Case intResponse
Case vbYes
Case vbNo
Cancel = True
Exit Sub
End Select
End If
If moRSPay.State = adStateOpen Then
moRSPay.Close
End If
If moRSCREW.State = adStateOpen Then
moRSCREW.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
End If
End Sub
Private Sub lblStart_Click()
End Sub
Private Sub lstCrew_Click()
On Error GoTo Error_EH
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
' If gboolMAS90 Then '***FIX Need to remove when new tables are setup
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
Call FormShowCrew
Else
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
txtHRate = "0"
txtHours = "0"
txtGross = "0"
txtTTLAmt = "0"
txtOTHrs = "0"
txtOTRate = "0"
txtOTAmt = "0"
txtTTLHrs = ""
txtTTLPay = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module lstCrew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_DblClick()
Dim intBOOKMARK As Integer
' frmCrewList.Show 1
' Call CrewLoad
intBOOKMARK = lstCrew.ListIndex
If moRSCREW!INCLUDE = vbTrue Then
moRSCREW!INCLUDE = vbFalse
ElseIf moRSCREW!INCLUDE = vbFalse Then
moRSCREW!INCLUDE = vbTrue
End If
moRSCREW.Update
Call CrewLoad
lstCrew.ListIndex = intBOOKMARK
cmdSavePay.Enabled = True
End Sub
Private Sub lstHouses_Click()
On Error GoTo Error_EH
If lstHouses.ListIndex <> -1 Then
If FormFindPay() Then
Call FormShowPay
Else
lblType.Caption = ""
lblAddress.Caption = ""
lblPay.Caption = ""
lblDYds.Caption = ""
lblDFin2.Caption = ""
lblDMetal.Caption = ""
lblDRate.Caption = ""
lblDRate2.Caption = ""
lblDMRate.Caption = ""
txtStone = ""
txtPaint = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module lstHouses_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstHouses_DblClick()
Dim intBOOKMARK As Integer
' frmCrewList.Show 1
' Call CrewLoad
If lstHouses.ListCount > 0 Then
intBOOKMARK = lstHouses.ListIndex
If moRSPay!INCLUDE = vbTrue Then
moRSPay!INCLUDE = vbFalse
ElseIf moRSPay!INCLUDE = vbFalse Then
moRSPay!INCLUDE = vbTrue
End If
moRSPay.Update
Call PayLoad
lstHouses.ListIndex = intBOOKMARK
End If
' cmdSavePay.Enabled = True
' cmdDetail.Visible = True
' cmdLook.Visible = True
' gintPROJID = moRSPay!proj_id
' gintLOTID = moRSPay!Lot_id
End Sub
Private Sub lstLots_DblClick()
Dim strPAYID As String
strPAYID = gintPAYID
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
lstLots.Visible = False
Load frmPayInput
frmPayInput.txtCrewNo = Field2Str(txtCrewId)
frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption)
frmPayInput.chkADD = vbChecked
frmPayInput.Show 1
lblSelect.Visible = False
lblCtrl.Visible = False
Call PayLoad
Call cmdTotal_Click
cmdAddLot.SetFocus
End Sub
Private Sub lstPaySheets_Click()
Dim strSQL As String, strID As String
Dim oRS As Recordset, strPAYID As String
'Got to find out where to get the tblTIME id or just open the tblTIME and add a new one.
lstPaySheets.col = 0
strID = lstPaySheets.ColText
strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
' oRS!crewID = 0
oRS!paid = vbUnchecked
oRS!timeid = 0
oRS!movepay = vbNo
' oRS!Amt = 0
' oRS!Y_Rate = 0
' oRS!m_Rate = 0
oRS.Update
oRS.Close
End If
glngPSID = strID
strPAYID = gintPAYID
End Sub
Private Sub lstPaySheets_DblClick()
Dim strPAYID As String, lngLOTID As Long, lngPROJID As Long
' Call lstPaySheets_Click
Call GetPay
mboolAdding = True
strPAYID = gintPAYID
lstPaySheets.col = 0
glngPSID = Field2Long(lstPaySheets.ColText)
lstPaySheets.col = 6
gintPROJID = Field2Long(lstPaySheets.ColText)
lstPaySheets.col = 7
gintLOTID = Field2Long(lstPaySheets.ColText)
Call FormSavePS
' gintLOTID = lstLots.ItemData(lstLots.ListIndex)
' lstLots.Visible = False
lstPaySheets.Visible = False
Load frmPayInput
' frmPayInput.lblTimeID = gintPAYID
frmPayInput.txtCrewNo = Field2Str(txtCrewId)
frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption)
frmPayInput.chkADD = vbChecked
frmPayInput.chkPS = vbChecked '**????? Not sure needed
frmPayInput.Show 1
lblSelect.Visible = False
lblCtrl.Visible = False
Call PayLoad
Call cmdTotal_Click
cmdAddLot.SetFocus
End Sub
Private Sub FormSavePS()
Dim strSQL As String
' On Error GoTo Error_EH
strSQL = "SELECT * FROM tblTIME" 'WHERE idnum = 1"
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
moRSTIME.AddNew
End If
strSQL = "SELECT * FROM tblLOTINFO WHERE LOT_ID = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not moRS.EOF Then
mstrTexture = Field2Str(moRS!texture)
End If
' Store the controls to the recordset
' If Not moRS.EOF Then
Call FieldsSavePS
' End If
' moRSMemo!payroll = Str2Field(txtLotNotes)
' moRSMemo.Update
Exit Sub
Error_EH:
Call ErrorHandler(moRSTIME.ActiveConnection)
Exit Sub
End Sub
Private Sub FieldsSavePS()
Dim lngTIMEID As Long, strID As String, strWT As String, strDESC As String, strCrewType As String
Call GetPS
' On Error GoTo Error_EH
With moRSTIME
!PROJ_ID = gintPROJID
!Lot_ID = gintLOTID
!lot_no = Str2Field(moRS!lot_no)
!paydt = Date
lstPaySheets.col = 2
!pay_type = Str2Field(lstPaySheets.ColText)
strCrewType = Str2Field(lstPaySheets.ColText)
' cboWorkType.col = 0
' strID = cboWorkType.ColText
lstPaySheets.col = 3
strWT = lstPaySheets.ColText
' cboWorkType.col = 2
' strDESC = cboWorkType.ColText
' !workdone = Left(Str2Field(cboWorkType.Text), 1)
!WorkDone = strWT
!C_USER = gstrLOGIN
!pct_done = 100
' !pct_done = Integer2Field(txtPercentDone)
!pay_id = gintPAYID
lstPaySheets.col = 1
!proj_lot = Field2Str(lstPaySheets.ColText) ') & " " & Trim(Field2Str(moRS!lot_no))
' !proj_lot = Trim(Field2Str(moRSProj!Proj_Code)) & " " & Trim(Field2Str(moRS!lot_no))
!yd_rate = Field2Str(moRSSPS!Y_Rate)
' !yd_rate = Double2Field(txtYRate)
If strCrewType = "S" And (mstrTexture = "DF" Or mstrTexture = "SS" Or mstrTexture = "RF" Or mstrTexture = "M2" Or mstrTexture = "M3" Or mstrTexture = "MF") Then
!fin2_Rate = Field2Str(moRSSPS!Y_Rate)
' !fin2_Rate = Field2Str(moRSSPS!m_Rate)
ElseIf strCrewType = "L" Then
!mtl_Rate = Field2Str(moRSSPS!M_Rate)
End If
' !bc = vbUnchecked
!ponum = 0
!scafid = 0
!up = vbUnchecked
!frames = 0
!crew = Integer2Field(txtCrewId)
!notes = Field2Str(moRSSPS!notes)
!StrtTM = 0
!Lunch = ".00"
!EndTM = 0
!NetTime = "0.00"
!WorkDay = 0
!pay_amt = Field2Str2(moRSSPS!GROSSPAY)
' !pay_amt = Str2Field(txtAmount)
' !notes = Str2Field(txtMDesc)
'' If chkBC Then
'' !bc = vbChecked
'' !pay_amt = (Double2Field(txtAmount) * -1)
' !pay_amt = (Integer2Field(txtAmount) * -1)
'' Else
'' !bc = vbUnchecked
'' !pay_amt = (Double2Field(txtAmount))
' !pay_amt = (Integer2Field(txtAmount))
'' End If
' !office = Str2Field(txtNotes)
!C_USER = gstrLOGIN
!Create = Date
!U_USER = gstrLOGIN
!Update = Date
End With
moRSTIME.Update
lngTIMEID = FindMax("tblTIME", "IDNUM")
'' With moRSPay
' !pdamt = Field2Str2(txtPayAmt)
'' !Amt = Field2Str2(txtAmount)
'' !GROSSPAY = Field2Str2(txtAmount)
'' !paid = vbChecked
'' !Y_Rate = Field2Str2(txtYRate)
'' !m_Rate = Field2Str2(txtMetal)
'' !crewID = Field2Str2(txtCrewID)
moRSSPS!timeid = lngTIMEID
'' End With
moRSSPS.Update
If mboolAdding Then
mboolAdding = False
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 = "FormScaffold - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub txtGross_GotFocus()
mdblGROSS = Field2Str2(txtGross)
Call FieldSelect(txtGross)
End Sub
Private Sub txtGross_LostFocus()
If Not IsNumeric(txtGross) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtGross = 0
txtGross.SetFocus
Exit Sub
End If
If Field2Str2(txtGross) <> mdblGROSS Then
cmdSavePay.Enabled = True
End If
If Not moRSCREW!tiebreak Then
Call CalcPay
Call cmdTotal_Click
End If
End Sub
Private Sub txtHours_GotFocus()
'********** Remove comment sign after moved to keeping track of time
' If Field2Str2(txtHours) = 0 And gbool2WK Then
' txtHours = 80
' ElseIf Field2Str2(txtHours) = 0 And gbool1WK Then
' txtHours = 40
' End If
If Field2Str2(txtHours) = 0 Then
txtHours = 40
End If
mdblHours = Field2Str2(txtHours)
Call FieldSelect(txtHours)
End Sub
Private Sub txtHours_LostFocus()
If Not IsNumeric(txtHours) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtHours = 0
txtHours.SetFocus
Exit Sub
End If
If Field2Str2(txtHours) <> mdblHours Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtHRate_GotFocus()
mdblRate = Field2Str2(txtHRate)
Call FieldSelect(txtHRate)
End Sub
Private Sub txtHRate_LostFocus()
If txtHRate = "" Then
txtHRate = 0
End If
If Not IsNumeric(txtHRate) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtHRate = 0
txtHRate.SetFocus
Exit Sub
End If
If Field2Str2(txtHRate) <> mdblRate Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub CalcPay()
If Field2Str2(txtGross) > 0 Then
If Field2Str2(txtHours = 0) Then
txtHours = 40
mdblHours = Field2Str2(txtHours)
cmdSavePay.Enabled = True
End If
If Field2Str2(txtHRate) = 0 Then
txtHRate = Format((Field2Str2(txtGross) / Field2Str2(txtHours)), "##.00##")
mdblRate = Field2Str2(txtHRate)
cmdSavePay.Enabled = True
End If
If Field2Str2(txtHRate) < gsngWAGE Then
MsgBox "The Hourly Rate is below $" & Format(gsngWAGE, "###.00") & ", Change the Hours Worked To Correct This", vbOKOnly, "Hourly Rate Problem"
txtHRate = 0
txtHours.SetFocus
End If
' Exit Sub
End If
If Field2Str2(txtHours) > 0 And Field2Str2(txtHRate) > 0 Then
If mdblHours <> Field2Str2(txtHours) Or mdblRate <> Field2Str2(txtHRate) Then
txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
If Field2Str2(txtGross) = 0 Then
txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
' Exit Sub
End If
If Field2Str2(txtOTHrs) > 0 And Field2Str2(txtOTRate) > 0 Then
If mdblOTHours <> Field2Str2(txtOTHrs) Or mdblOTRate <> Field2Str2(txtOTRate) Then
txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00")
cmdSavePay.Enabled = True
ElseIf Field2Str2(txtOTAmt) = 0 Then
txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
' Exit Sub
End If
If Field2Str2(txtGross) > 0 Or Field2Str2(txtOTAmt) > 0 Then
txtTTLAmt = CDbl(Field2Str2(txtGross)) + CDbl(Field2Str2(txtOTAmt))
txtTTLAmt = Format(txtTTLAmt, "#,#,#.00")
End If
End Sub
Private Sub txtOTAmt_GotFocus()
mdblOTGROSS = Field2Str2(txtOTAmt)
Call FieldSelect(txtOTAmt)
End Sub
Private Sub txtOTAmt_LostFocus()
If Not IsNumeric(txtOTAmt) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTAmt = 0
txtOTAmt.SetFocus
Exit Sub
End If
If Field2Str2(txtOTAmt) <> mdblOTGROSS Then
cmdSavePay.Enabled = True
End If
Call CalcPay
Call cmdTotal_Click
End Sub
Private Sub txtOTHrs_GotFocus()
txtOTHrs = Field2Str2(txtOTHrs)
mdblOTHours = Field2Str2(txtOTHrs)
Call FieldSelect(txtOTHrs)
End Sub
Private Sub txtOTHrs_LostFocus()
If Not IsNumeric(txtOTHrs) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTHrs = 0
txtOTHrs.SetFocus
Exit Sub
End If
If Field2Str2(txtOTHrs) <> mdblOTHours Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtOTRate_GotFocus()
mdblOTRate = Field2Str2(txtOTRate)
Call FieldSelect(txtOTRate)
End Sub
Private Sub txtOTRate_LostFocus()
If txtOTRate = "" Then
txtOTRate = 0
End If
If Not IsNumeric(txtOTRate) Then
' Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTRate = 0
txtOTRate.SetFocus
Exit Sub
End If
If Field2Str2(txtOTRate) <> mdblOTRate Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtTTLAmt_GotFocus()
Call FieldSelect(txtTTLAmt)
End Sub
Private Sub txtTTLHrs_GotFocus()
Call FieldSelect(txtTTLHrs)
End Sub
Private Sub CalcWages()
If Field2Str2(txtTTLHrs) <= 40 Then
lblCalcHrs = Field2Str2(txtTTLHrs)
txtHours = txtTTLHrs
txtHRate = Field2Str2(txtTTLPay) / Field2Str2(lblCalcHrs)
txtHRate = Format(Round(Field2Str2(txtHRate), 4), "#,0.00##")
ElseIf Field2Str2(txtTTLHrs) > 40 Then
lblCalcHrs = (((Field2Str2(txtTTLHrs) - 40) * 1.5) + 40)
txtHours = 40
txtOTHrs = Field2Str2(txtTTLHrs) - 40
txtHRate = Field2Str2(txtTTLPay) / Field2Str2(lblCalcHrs)
txtOTRate = Field2Str2(txtHRate) * 1.5
txtHRate = Format(Round(Field2Str2(txtHRate), 4), "#,0.00##")
txtOTRate = Format(Round(Field2Str2(txtOTRate), 4), "#,0.00##")
End If
End Sub
Private Sub txtTTLPay_GotFocus()
Call FieldSelect(txtTTLPay)
End Sub
Private Sub txtTTLPay_LostFocus()
txtTTLPay = Format(txtTTLPay, "#,##0.00")
End Sub
Reference in New Issue View Git Blame Copy Permalink