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/LogFiles/frmCrewsNEW.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

1877 lines
54 KiB
Plaintext
Raw Permalink 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 frmCrewsNEW
Caption = "Lath and Stucco Crews"
ClientHeight = 8490
ClientLeft = 165
ClientTop = 450
ClientWidth = 15105
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 8490
ScaleWidth = 15105
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdClose
Caption = "Close Project"
Enabled = 0 'False
Height = 555
Left = 7455
TabIndex = 51
Top = 5730
Width = 990
End
Begin VB.CommandButton cmdSave2
Caption = "Save Project"
Enabled = 0 'False
Height = 555
Left = 6270
TabIndex = 26
Top = 5730
Width = 990
End
Begin VB.CommandButton Command1
Caption = "Use Default Rates"
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 = 8490
TabIndex = 48
Top = 5730
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdAddProj
Caption = "Add Project"
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 = 5070
TabIndex = 47
Top = 5730
Width = 990
End
Begin VB.CheckBox chkRates
Caption = "Show Project Rates"
Height = 285
Left = 7695
TabIndex = 46
Top = 990
Width = 1770
End
Begin VB.TextBox txtProjCode
Enabled = 0 'False
Height = 285
Left = 6060
MaxLength = 6
TabIndex = 42
Top = 1335
Visible = 0 'False
Width = 975
End
Begin LpLib.fpList lstProj
Height = 3780
Left = 75
TabIndex = 40
Top = 4515
Width = 4860
_Version = 196608
_ExtentX = 8572
_ExtentY = 6667
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 = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 4
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= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmCrewsNEW.frx":0000
End
Begin VB.CheckBox chkBiWeekly
Caption = "Bi Weekly PR"
Height = 210
Left = 7710
TabIndex = 39
Top = 60
Visible = 0 'False
Width = 1500
End
Begin VB.CheckBox chkINACTIVE
Caption = "Inactive Crew"
Height = 330
Left = 7710
TabIndex = 38
Top = 285
Width = 1470
End
Begin Crystal.CrystalReport crCrew
Left = 5310
Top = 165
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.TextBox txtEndDate
Height = 300
Left = 7590
TabIndex = 35
Top = 3300
Visible = 0 'False
Width = 1095
End
Begin VB.TextBox txtBegDate
Height = 300
Left = 7590
TabIndex = 34
Top = 2760
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton cmdPrint
Caption = "Print Pay List"
Enabled = 0 'False
Height = 555
Left = 7455
TabIndex = 36
ToolTipText = "Enter Dates Before Printing"
Top = 6300
Width = 990
End
Begin VB.TextBox txtEmpNo
Alignment = 1 'Right Justify
Height = 285
Left = 6405
TabIndex = 17
Top = 2475
Width = 975
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
Height = 555
Left = 8655
TabIndex = 29
TabStop = 0 'False
Top = 6300
Width = 990
End
Begin VB.CommandButton cmdSave
Caption = "&Save Crew"
Enabled = 0 'False
Height = 555
Left = 6270
TabIndex = 27
Top = 6300
Width = 990
End
Begin VB.CommandButton cmdAdd
Caption = "&Add Crew"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5070
TabIndex = 28
TabStop = 0 'False
Top = 6300
Width = 990
End
Begin VB.TextBox txtDA
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 24
Top = 4995
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtQU
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 23
Top = 4635
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSB
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 25
Top = 5355
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtMN
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 22
Top = 4275
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSM
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 21
Top = 3915
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSA
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 20
Top = 3555
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtPrimRate
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 19
Top = 3195
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtMetal
Alignment = 1 'Right Justify
Height = 285
Left = 6405
MaxLength = 9
TabIndex = 18
Top = 2835
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtPhone
Alignment = 1 'Right Justify
Height = 285
Left = 6060
MaxLength = 10
TabIndex = 16
Top = 990
Width = 1575
End
Begin VB.TextBox txtCrewBoss
Height = 285
Left = 6060
MaxLength = 30
TabIndex = 15
Top = 660
Width = 3435
End
Begin VB.ComboBox cboType
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
ItemData = "frmCrewsNEW.frx":0367
Left = 3180
List = "frmCrewsNEW.frx":037D
Style = 2 'Dropdown List
TabIndex = 2
Top = 75
Width = 1755
End
Begin VB.ListBox lstCrew
Height = 3960
Left = 60
Sorted = -1 'True
TabIndex = 0
Top = 495
Width = 4875
End
Begin LpLib.fpList lstCProj
Height = 6915
Left = 8820
TabIndex = 49
Top = 1380
Visible = 0 'False
Width = 6285
_Version = 196608
_ExtentX = 11086
_ExtentY = 12197
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 = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 5
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 = 2
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 = "frmCrewsNEW.frx":03B8
End
Begin VB.TextBox txtProjDesc
Enabled = 0 'False
Height = 285
Left = 6060
TabIndex = 44
Top = 1665
Width = 3435
End
Begin VB.Label lblProjInst
BackColor = &H00C0FFFF&
Caption = $"frmCrewsNEW.frx":074E
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1245
Left = 9645
TabIndex = 50
Top = 15
Width = 5490
End
Begin VB.Label lblProjName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Project:"
Height = 195
Left = 5460
TabIndex = 45
Top = 1680
Width = 540
End
Begin VB.Label lblProjID
Height = 195
Left = 7125
TabIndex = 43
Top = 1350
Width = 1860
End
Begin VB.Label lblProjCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Project Code:"
Height = 195
Left = 5040
TabIndex = 41
Top = 1350
Visible = 0 'False
Width = 960
End
Begin VB.Label lblPrintInfo
Caption = $"frmCrewsNEW.frx":0837
ForeColor = &H000000FF&
Height = 1230
Left = 7575
TabIndex = 37
Top = 3645
Visible = 0 'False
Width = 1785
End
Begin VB.Label lblEndDate
AutoSize = -1 'True
Caption = "Ending Print Date:"
Height = 195
Left = 7590
TabIndex = 33
Top = 3090
Visible = 0 'False
Width = 1290
End
Begin VB.Label lblBegDate
AutoSize = -1 'True
Caption = "Beginning Print Date:"
Height = 195
Left = 7590
TabIndex = 32
Top = 2520
Visible = 0 'False
Width = 1500
End
Begin VB.Label lblEmpNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Employee No:"
Height = 195
Left = 5325
TabIndex = 31
Top = 2535
Width = 990
End
Begin VB.Label lblInstructions
Caption = $"frmCrewsNEW.frx":08D2
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1320
Left = 5085
TabIndex = 30
Top = 6930
Width = 4545
End
Begin VB.Label lblDA
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Dash Rate:"
Height = 195
Left = 5535
TabIndex = 14
Top = 5055
Visible = 0 'False
Width = 810
End
Begin VB.Label lblCrewId
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6435
TabIndex = 13
Top = 285
Width = 975
End
Begin VB.Label lblQU
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quernavaca Rate:"
Height = 195
Left = 5025
TabIndex = 12
Top = 4695
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblSB
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Synthetic Rate:"
Height = 195
Left = 5250
TabIndex = 11
Top = 5415
Visible = 0 'False
Width = 1095
End
Begin VB.Label lblMN
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Monterrey Rate:"
Height = 195
Left = 5205
TabIndex = 10
Top = 4290
Visible = 0 'False
Width = 1140
End
Begin VB.Label lblSmooth
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Smooth Rate:"
Height = 195
Left = 5370
TabIndex = 9
Top = 4005
Visible = 0 'False
Width = 975
End
Begin VB.Label lblSand
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sand Rate:"
Height = 195
Left = 5535
TabIndex = 8
Top = 3645
Visible = 0 'False
Width = 810
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 5520
TabIndex = 7
Top = 2940
Visible = 0 'False
Width = 825
End
Begin VB.Label lblPrimRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Rate:"
Height = 195
Left = 5595
TabIndex = 6
Top = 3300
Visible = 0 'False
Width = 750
End
Begin VB.Label lblPhone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Phone #:"
Height = 195
Left = 5340
TabIndex = 5
Top = 1050
Width = 660
End
Begin VB.Label lblName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Leader:"
Height = 195
Left = 5055
TabIndex = 4
Top = 720
Width = 945
End
Begin VB.Label lblCrewNum
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew #:"
Height = 195
Left = 5820
TabIndex = 3
Top = 345
Width = 555
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Select The Crew Type To Display A List:"
ForeColor = &H000000FF&
Height = 195
Left = 120
TabIndex = 1
Top = 120
Width = 2865
End
End
Attribute VB_Name = "frmCrewsNEW"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSCREW As Recordset, moRSPRATE As Recordset
Dim mintCREW As Integer, mlngProj As Long
Dim mboolAdding As Boolean
' lstCREW Height 3960 or 7470
' need to make it so the save keys work for just crews and for projects.
' make sure that if there is a project labor rate then that displays not the
' default labor rate.
'
Private Sub cboType_Change()
Call CrewLoad
If Len(cboType.Text) <> 0 Then
cmdAdd.Enabled = True
End If
End Sub
Private Sub cboType_Click()
Call CrewLoad
If Len(cboType.Text) <> 0 Then
cmdAdd.Enabled = True
End If
End Sub
Private Sub LoadCProj()
Dim strSQL As String, oRS As Recordset, strLine As String
cmdAddProj.Enabled = False
cmdSave.Enabled = True
strSQL = "SELECT Proj_ID,Proj_Code, Proj_Desc, Proj_Cont FROM tblProject WHERE GotBid and Not Complete"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
frmCrewsNEW.Left = 0
frmCrewsNEW.Width = 15225
lstCProj.Clear
Do Until oRS.EOF
strLine = Field2Str2(oRS!proj_id) & vbTab & Field2Str(oRS!proj_code) & vbTab & Field2Str(oRS!proj_cont) & vbTab & Field2Str(oRS!proj_desc)
lstCProj.AddItem strLine
oRS.MoveNext
Loop
End Sub
Private Sub chkRates_Click()
Dim intBookmark As Integer
intBookmark = lstCrew.ListIndex
If chkRates = vbChecked Then
lstCrew.Enabled = False
lstCrew.Height = 3960
lstProj.Visible = True
txtProjCode.Visible = True
lblProjCode.Visible = True
txtProjDesc = ""
cmdAdd.Enabled = False
cmdAddProj.Enabled = True
Call ProjLoad
End If
If chkRates = vbUnchecked Then
lstProj.ListIndex = -1
lstCrew.Enabled = True
If cmdClose.Enabled = True Then
cmdClose.Enabled = False
Call FormShowCrew
End If
lstCProj.Visible = False
lblInstructions.Visible = True
cmdExit.Visible = True
frmCrewsNEW.Width = 9750
lstCrew.Height = 7470
lstProj.Visible = False
txtProjCode.Visible = False
lblProjCode.Visible = False
txtProjDesc = "Default Pay Rates for This Crew"
cmdAdd.Enabled = True
cmdAddProj.Enabled = False
End If
If lstCrew.Enabled <> False Or lstProj.ListCount = 0 Then
Call CrewLoad
End If
lstCrew.ListIndex = intBookmark
' Call ProjLoad
End Sub
Private Sub cmdAdd_Click()
cmdAdd.Enabled = False
cmdSave.Enabled = True
mboolAdding = True
Call FormClear
txtCrewBoss.SetFocus
End Sub
Private Sub cmdAddProj_Click()
' frmCrewsNEW.Width = 0
lstCProj.Visible = True
cmdExit.Visible = False
lblInstructions.Visible = False
cmdClose.Enabled = True
Call LoadCProj
' frmProjCur.Show
End Sub
Private Sub cmdClose_Click()
' frmCrewsNEW.Width = 0
lstCProj.Visible = False
cmdExit.Visible = True
frmCrewsNEW.Width = 9750
If lstProj.Visible <> True Then
lstCrew.Height = 7470
Else
lstCrew.Height = 3960
End If
lblInstructions.Visible = True
lstCProj.Clear
lstCrew.Enabled = True
lstCrew.SetFocus
cmdAdd.Enabled = True
cmdClose.Enabled = False
txtProjCode.Visible = False
lblProjCode.Visible = False
txtProjDesc = "Default Pay Rates for This Crew"
If lstProj.ListCount > 0 Then
Call lstProj_Click
Else
Call lstCrew_Click ' **** may need to change this to lstproj_click if lstproj.listcount > 0
End If
' Call LoadCProj
' frmProjCur.Show
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
lstCrew.Enabled = True
cmdAdd.Enabled = True
cmdSave.Enabled = False
cmdPrint.Enabled = False
lblPrintInfo.Visible = False
lblBegDate.Visible = False
lblEndDate.Visible = False
txtBegDate.Visible = False
txtEndDate.Visible = False
Call PrintPay
End Sub
Private Sub cmdSave_Click()
Dim intBookmark As Integer
intBookmark = lstCrew.ListIndex
lstCrew.Enabled = True
cmdAdd.Enabled = True
cmdSave.Enabled = False
cmdPrint.Enabled = False
lblPrintInfo.Visible = False
lblBegDate.Visible = False
lblEndDate.Visible = False
txtBegDate.Visible = False
txtEndDate.Visible = False
Call FormSave
lstCrew.ListIndex = intBookmark
End Sub
Private Sub cmdSave2_Click()
Dim intBookmark As Integer
intBookmark = lstProj.ListIndex
lstProj.Enabled = True
' cmdAdd.Enabled = True
cmdSave2.Enabled = False
' cmdPrint.Enabled = False
lblPrintInfo.Visible = False
lblBegDate.Visible = False
lblEndDate.Visible = False
txtBegDate.Visible = False
txtEndDate.Visible = False
Call FormSave2
lstProj.ListIndex = intBookmark
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
frmCrewsNEW.Width = 9750
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
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
lstCrew.Height = 7470
lstProj.Visible = False
txtProjDesc = "Default Pay Rates for This Crew"
Call CrewLoad
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
Call FormShowCrew
End If
End If
' Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT crew_id, crew_boss from tblCrew WHERE type = '" & Left$(cboType, 1) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
Do Until oRS.EOF
With lstCrew
If Len(Field2Str(oRS!crew_boss)) < 14 Then
strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id)
ElseIf Len(Field2Str(oRS!crew_boss)) > 20 Then
strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id)
Else
strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id)
End If
.AddItem strLine
.ItemData(.NewIndex) = oRS!crew_id
End With
oRS.MoveNext
Loop
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = -1
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjLoad()
Dim oRSS As Recordset
Dim strSQLR As String, intCREWID As Integer
Dim strLine As String
On Error GoTo Error_EH
intCREWID = lstCrew.ItemData(lstCrew.ListIndex)
strSQLR = "SELECT rate_id, proj_id, proj_code, proj_desc, crew_id FROM tblCREWRATE WHERE crew_id = " & intCREWID
Set oRSS = New Recordset
oRSS.Open strSQLR, goConn, adOpenForwardOnly, adLockReadOnly
lstProj.Clear
Do Until oRSS.EOF
With lstProj
strLine = Field2Str2(oRSS!Rate_id) & vbTab & " " & Field2Str(oRSS!proj_code) & vbTab & Field2Str(oRSS!proj_desc) & vbTab & Field2Str2(oRSS!proj_id) & vbTab & Field2Str2(oRSS!Rate_id)
' If Len(Field2Str(oRSS!crew_boss)) < 14 Then
' strLine = Format(Field2Str(oRSS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRSS!crew_id)
' ElseIf Len(Field2Str(oRSS!crew_boss)) > 20 Then
' strLine = Format(Field2Str(oRSS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRSS!crew_id)
' Else
' strLine = Format(Field2Str(oRSS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRSS!crew_id)
' End If
.AddItem strLine
' .ItemData(.NewIndex) = oRSS!crew_id
End With
oRSS.MoveNext
Loop
If lstProj.ListCount Then
lstProj.ListIndex = 0
Else
lstProj.ListIndex = -1
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindCrew() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblCrew "
strSQL = strSQL & "WHERE crew_Id = " & lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSCREW.EOF Then
FormFindCrew = False
Else
FormFindCrew = True
End If
Exit Function
Error_EH:
gstrMODULE = "FormCrews - Module FormFindCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindProj() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblCREWRATE "
strSQL = strSQL & "WHERE crew_Id = " & lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSCREW.EOF Then
FormFindCrew = False
Else
FormFindCrew = True
End If
Exit Function
Error_EH:
gstrMODULE = "FormCrews - Module FormFindProj"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShowProj()
Dim strSQL As String, lngRATEID As Long
Dim oRS As Recordset
On Error GoTo Error_EH
lstProj.col = 4
lngRATEID = Field2Long(lstProj.ColText)
strSQL = "SELECT * FROM tblCREWRATE WHERE Rate_ID = " & lngRATEID
Set moRSPRATE = New Recordset
moRSPRATE.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
With moRSPRATE
If Left$(cboType, 1) = "L" Then
lblPrimRate.Caption = "Lath:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = True
lblMetal.Visible = True
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = False
lblSand.Visible = False
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
ElseIf Left$(cboType, 1) = "S" Then
lblPrimRate.Caption = "Skip:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = True
lblDA.Visible = True
txtQU.Visible = True
lblQU.Visible = True
txtSM.Visible = True
lblSmooth.Visible = True
txtSA.Visible = True
lblSand.Visible = True
txtSB.Visible = True
lblSB.Visible = True
txtMN.Visible = True
lblMN.Visible = True
End If
ElseIf Left$(cboType, 1) = "V" Then
lblPrimRate.Caption = "Stone:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = False
lblSand.Visible = False
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
ElseIf Left$(cboType, 1) = "C" Then
lblPrimRate.Caption = "Up:"
lblSand.Caption = "Down:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = True
lblSand.Visible = True
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
End If
lblCrewId.Caption = Field2Str(!crew_id)
txtCrewBoss = Field2Str(!crew_boss)
' txtPhone = Field2Str(!phone)
txtEmpNo = Field2Str(!EMPNO)
txtPrimRate = Format(Field2Str2(!lath_skip), "#0.00")
txtMetal = Format(Field2Str2(!METAL), "#0.00#")
txtSA = Format(Field2Str2(!sand), "#0.00")
txtSM = Format(Field2Str2(!Smooth), "#0.00")
txtQU = Format(Field2Str2(!qu), "#0.00")
txtDA = Format(Field2Str2(!dash), "#0.00")
txtMN = Format(Field2Str2(!mn), "#0.00")
txtSB = Format(Field2Str2(!syn), "#0.00")
txtProjCode = Field2Str(!proj_code)
txtProjDesc = Field2Str(!proj_desc)
' chkINACTIVE = Field2CheckBox(!inactive)
' chkBiWeekly = Field2CheckBox(!BiWeekly)
End With
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module FormShowProj"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowCrew()
Dim strSQL As String, lngRATEID As Long
Dim oRS As Recordset
On Error GoTo Error_EH
' lstProj.col = 4
' lngRATEID = Field2Long(lstProj.ColText)
' strSQL = "SELECT * FROM tblCREWRATE WHERE Rate_ID = " & lngRATEID
' Set moRSPRATE = New Recordset
' moRSPRATE.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
With moRSCREW
If Left$(cboType, 1) = "L" Then
lblPrimRate.Caption = "Lath:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = True
lblMetal.Visible = True
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = False
lblSand.Visible = False
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
ElseIf Left$(cboType, 1) = "S" Then
lblPrimRate.Caption = "Skip:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = True
lblDA.Visible = True
txtQU.Visible = True
lblQU.Visible = True
txtSM.Visible = True
lblSmooth.Visible = True
txtSA.Visible = True
lblSand.Visible = True
txtSB.Visible = True
lblSB.Visible = True
txtMN.Visible = True
lblMN.Visible = True
End If
ElseIf Left$(cboType, 1) = "V" Then
lblPrimRate.Caption = "Stone:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = False
lblSand.Visible = False
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
ElseIf Left$(cboType, 1) = "C" Then
lblPrimRate.Caption = "Up:"
lblSand.Caption = "Down:"
If gbytSECURITY = 1 Or gbytSECURITY = 10 Then
txtPrimRate.Visible = True
lblPrimRate.Visible = True
txtMetal.Visible = False
lblMetal.Visible = False
txtDA.Visible = False
lblDA.Visible = False
txtQU.Visible = False
lblQU.Visible = False
txtSM.Visible = False
lblSmooth.Visible = False
txtSA.Visible = True
lblSand.Visible = True
txtSB.Visible = False
lblSB.Visible = False
txtMN.Visible = False
lblMN.Visible = False
End If
End If
lblCrewId.Caption = Field2Str(!crew_id)
txtCrewBoss = Field2Str(!crew_boss)
txtPhone = Field2Str(!phone)
txtEmpNo = Field2Str(!EMPNO)
txtPrimRate = Format(Field2Str2(!lath_skip), "#0.00")
txtMetal = Format(Field2Str2(!METAL), "#0.00#")
txtSA = Format(Field2Str2(!sand), "#0.00")
txtSM = Format(Field2Str2(!Smooth), "#0.00")
txtQU = Format(Field2Str2(!qu), "#0.00")
txtDA = Format(Field2Str2(!dash), "#0.00")
txtMN = Format(Field2Str2(!mn), "#0.00")
txtSB = Format(Field2Str2(!syn), "#0.00")
txtProjDesc = "Default Pay Rates for This Crew"
' chkINACTIVE = Field2CheckBox(!inactive)
' chkBiWeekly = Field2CheckBox(!BiWeekly)
End With
Exit Sub
Error_EH:
gstrMODULE = "FormCrews - Module FormShowCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
lblCrewId.Caption = ""
txtCrewBoss = ""
txtPhone = ""
txtEmpNo = ""
txtPrimRate = 0
txtMetal = 0
txtSA = 0
txtSM = 0
txtQU = 0
txtDA = 0
txtMN = 0
txtSB = 0
txtProjCode = ""
txtProjDesc = ""
chkINACTIVE = vbUnchecked
chkBiWeekly = vbUnchecked
End Sub
Private Sub FieldsSave()
Dim strLOT As String, test As String
On Error GoTo 0
On Error GoTo Error_EH
With moRSCREW
!U_USER = gstrLOGIN
!Update = Date
!crew_boss = Str2Field(txtCrewBoss)
!phone = Str2Field(txtPhone)
!Type = Left$(Str2Field(cboType), 1)
!METAL = Str2Field(txtMetal)
!lath_skip = Str2Field(txtPrimRate)
!sand = Str2Field(txtSA)
!qu = Str2Field(txtQU)
!dash = Str2Field(txtDA)
!Smooth = Str2Field(txtSM)
!syn = Str2Field(txtSB)
!mn = Str2Field(txtMN)
!EMPNO = Format(Field2Str2(txtEmpNo), "0000000")
!inactive = chkINACTIVE
!BiWeekly = chkBiWeekly
End With
test = moRSCREW.EditMode
moRSCREW.Update
Call CrewLoad
If mboolAdding Then
Call CrewLoad
If FormFindCrew() Then
Call FormShowCrew
End If
End If
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
Resume Next
End If
gstrMODULE = "FormCrews - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSaveP()
Dim strLOT As String, test As String
On Error GoTo 0
' On Error GoTo Error_EH
With moRSPRATE
!U_USER = gstrLOGIN
!Update = Date
!crew_boss = Str2Field(txtCrewBoss)
' !phone = Str2Field(txtPhone)
!Type = Left$(Str2Field(cboType), 1)
!METAL = Str2Field(txtMetal)
!lath_skip = Str2Field(txtPrimRate)
!sand = Str2Field(txtSA)
!qu = Str2Field(txtQU)
!dash = Str2Field(txtDA)
!Smooth = Str2Field(txtSM)
!syn = Str2Field(txtSB)
!mn = Str2Field(txtMN)
' !EMPNO = Format(Field2Str2(txtEmpNo), "0000000")
' !inactive = chkINACTIVE
' !BiWeekly = chkBiWeekly
End With
' test = moRSCREW.EditMode
moRSPRATE.Update
Call ProjLoad
If mboolAdding Then
Call ProjLoad
If FormFindProj() Then
Call FormShowProj
End If
End If
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
Resume Next
End If
gstrMODULE = "FormCrews - Module FieldsSaveP"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
If mboolAdding Then
moRSCREW.AddNew
moRSCREW!C_USER = gstrLOGIN
End If
' Store the controls to the recordset
Call FieldsSave
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSCREW.ActiveConnection)
Exit Sub
End Sub
Private Sub FormSave2()
Dim strName As String
On Error GoTo Error_EH
' If mboolAdding Then
' moRSCREW.AddNew
' moRSCREW!C_USER = gstrLOGIN
' End If
' Store the controls to the recordset
Call FieldsSaveP
' If mboolAdding Then
' mboolAdding = False
' End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSPRATE.ActiveConnection)
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
If cmdSave.Enabled Then
strMSG = "Crew 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 FormSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
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 lstCProj_DblClick()
Dim strSQL As String, oRS As Recordset
Dim strPROJID As String, strPROJCODE As String, strPROJDESC As String
strSQL = "SELECT * FROM tblCREWRATE"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
lstCProj.col = 1
strPROJCODE = lstCProj.ColText
lstCProj.col = 0
strPROJID = lstCProj.ColText
lstCProj.col = 3
strPROJDESC = lstCProj.ColText
If Not oRS.EOF Then
oRS.AddNew
oRS!crew_id = Field2Str2(moRSCREW!crew_id)
oRS!crew_boss = Field2Str(moRSCREW!crew_boss)
oRS!Type = Field2Str(moRSCREW!Type)
oRS!METAL = Field2Str2(moRSCREW!METAL)
oRS!lath_skip = Field2Str(moRSCREW!lath_skip)
oRS!sand = Field2Str2(moRSCREW!sand)
oRS!Smooth = Field2Str2(moRSCREW!Smooth)
oRS!mn = Field2Str2(moRSCREW!mn)
oRS!dash = Field2Str2(moRSCREW!dash)
oRS!syn = Field2Str2(moRSCREW!syn)
oRS!qu = Field2Str2(moRSCREW!qu)
oRS!Current = Field2Str(moRSCREW!Current)
oRS!EMPNO = Field2Str2(moRSCREW!EMPNO)
oRS!Create = Date
oRS!C_USER = gstrLOGIN
oRS!proj_id = strPROJID
oRS!proj_code = strPROJCODE
oRS!proj_desc = strPROJDESC
oRS.Update
End If
Call ProjLoad
End Sub
Private Sub lstCrew_Click()
On Error GoTo Error_EH
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
Call FormShowCrew
mintCREW = lstCrew.ItemData(lstCrew.ListIndex)
Else
lstCrew.Clear
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Crews - Module lstCrew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_DblClick()
txtBegDate = ""
txtEndDate = ""
cmdAdd.Enabled = False
' cmdPrint.Enabled = True
cmdSave.Enabled = True
lblPrintInfo.Visible = True
lblBegDate.Visible = True
lblEndDate.Visible = True
txtBegDate.Visible = True
txtEndDate.Visible = True
txtCrewBoss.SetFocus
End Sub
Private Sub lstProj_Click()
On Error GoTo Error_EH
If lstProj.ListIndex <> -1 Then
' If FormFindProj() Then
Call FormShowProj
' mintCREW = lstProj.ItemData(lstProj.ListIndex)
Else
' lstProj.Clear
Call FormClear
' End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Crews - Module lstProj_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstProj_DblClick()
' txtBegDate = ""
' txtEndDate = ""
cmdAddProj.Enabled = False
' cmdPrint.Enabled = True
cmdSave2.Enabled = True
' lblPrintInfo.Visible = True
' lblBegDate.Visible = True
' lblEndDate.Visible = True
' txtBegDate.Visible = True
' txtEndDate.Visible = True
' txtCrewBoss.SetFocus
txtPrimRate.SetFocus
End Sub
Private Sub txtBegDate_GotFocus()
Call FieldSelect(txtBegDate)
End Sub
Private Sub txtBegDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtBegDate, "/", 1)
If Not IsDate(txtBegDate) Then
If lngPOS = 0 Then
If Len(txtBegDate) > 0 Then
txtBegDate = Format(txtBegDate, "00/00/####")
If Not IsDate(txtBegDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtBegDate.SetFocus
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtBegDate.SetFocus
End If
End If
End Sub
Private Sub txtCrewBoss_GotFocus()
Call FieldSelect(txtCrewBoss)
End Sub
Private Sub txtCrewBoss_LostFocus()
txtCrewBoss = UCase(txtCrewBoss)
End Sub
Private Sub txtDA_GotFocus()
Call FieldSelect(txtDA)
End Sub
Private Sub txtEmpNo_GotFocus()
Call FieldSelect(txtEmpNo)
End Sub
Private Sub txtEndDate_GotFocus()
Call FieldSelect(txtEndDate)
End Sub
Private Sub txtEndDate_LostFocus()
Dim lngPOS As Long
If txtBegDate <> "" Or Len(txtBegDate) > 0 Then
If Not IsDate(txtBegDate) Then
MsgBox "You Must Enter A Valid Date In The Beginning Date Field", , "Invalid Date - ReEnter"
txtEndDate = ""
txtBegDate.SetFocus
Exit Sub
End If
End If
lngPOS = InStr(1, txtEndDate, "/", 1)
If Not IsDate(txtEndDate) Then
If lngPOS = 0 Then
If Len(txtEndDate) > 0 Then
txtEndDate = Format(txtEndDate, "00/00/####")
If Not IsDate(txtEndDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtEndDate.SetFocus
ElseIf txtEndDate < txtBegDate Then
MsgBox "Ending Date cannot be earlier than the Beginning Date"
txtEndDate.SetFocus
Else
cmdPrint.Enabled = True
cmdPrint.SetFocus
lstCrew.Enabled = False
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtEndDate.SetFocus
End If
End If
' cmdPrint.Enabled = True
End Sub
Private Sub txtMetal_GotFocus()
Call FieldSelect(txtMetal)
End Sub
Private Sub txtMN_GotFocus()
Call FieldSelect(txtMN)
End Sub
Private Sub txtPhone_GotFocus()
Call FieldSelect(txtPhone)
End Sub
Private Sub txtPrimRate_GotFocus()
Call FieldSelect(txtPrimRate)
End Sub
Private Sub txtQU_GotFocus()
Call FieldSelect(txtQU)
End Sub
Private Sub txtSA_GotFocus()
Call FieldSelect(txtSA)
End Sub
Private Sub txtSB_GotFocus()
Call FieldSelect(txtSB)
End Sub
Private Sub txtSM_GotFocus()
Call FieldSelect(txtSM)
End Sub
Private Sub PrintPay()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, intYN As Integer
Dim strSELECT As String
Dim strBegDate As String, strEndDate As String
Dim intBYear As String, intBMonth As String, intBDay As String
Dim intEYear As String, intEMonth As String, intEDay As String
On Error GoTo Error_EH
gboolPRINT = True
intYN = MsgBox("Do You Want To Print to the Printer?", vbYesNo, "Window or Printer")
If gboolPRINT Then
intBYear = Mid(txtBegDate, 7, 4)
intBDay = Format(Mid(txtBegDate, 4, 2), "00")
intBMonth = Format(Mid(txtBegDate, 1, 2), "00")
intEYear = Mid(txtEndDate, 7, 4)
intEDay = Format(Mid(txtEndDate, 4, 2), "00")
intEMonth = Format(Mid(txtEndDate, 1, 2), "00")
crCrew.ReportFileName = App.Path & "\CrewPayByDate.rpt"
crCrew.Formulas(3) = "Z_BegDate = Date(" & intBYear & "," & intBMonth & "," & intBDay & ")"
crCrew.Formulas(4) = "Z_Crew = " & mintCREW
crCrew.Formulas(5) = "Z_EndDate = Date(" & intEYear & "," & intEMonth & "," & intEDay & ")"
If intYN = vbYes Then
crCrew.Destination = crptToPrinter
Else
crCrew.Destination = crptToWindow
End If
crCrew.Action = 1
gboolPRINT = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Crew - Module PrintPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Reference in New Issue View Git Blame Copy Permalink