Files
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmCrews.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

1058 lines
30 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Begin VB.Form frmCrews
Caption = "Lath and Stucco Crews"
ClientHeight = 7830
ClientLeft = 60
ClientTop = 345
ClientWidth = 9645
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 7830
ScaleWidth = 9645
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkBiWeekly
Caption = "Bi Weekly PR"
Height = 210
Left = 7695
TabIndex = 38
Top = 375
Width = 1500
End
Begin VB.CheckBox chkINACTIVE
Caption = "Inactive Crew"
Height = 330
Left = 7695
TabIndex = 37
Top = 600
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 = 7605
TabIndex = 34
Top = 2625
Visible = 0 'False
Width = 1095
End
Begin VB.TextBox txtBegDate
Height = 300
Left = 7605
TabIndex = 33
Top = 2085
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton cmdPrint
Caption = "Print Pay List"
Enabled = 0 'False
Height = 555
Left = 7400
TabIndex = 35
ToolTipText = "Enter Dates Before Printing"
Top = 5280
Width = 990
End
Begin VB.TextBox txtEmpNo
Alignment = 1 'Right Justify
Height = 315
Left = 6420
TabIndex = 17
Top = 1800
Width = 975
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
Height = 555
Left = 8595
TabIndex = 28
TabStop = 0 'False
Top = 5280
Width = 990
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Enabled = 0 'False
Height = 555
Left = 6205
TabIndex = 26
Top = 5280
Width = 990
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Enabled = 0 'False
Height = 555
Left = 5010
TabIndex = 27
TabStop = 0 'False
Top = 5280
Width = 990
End
Begin VB.TextBox txtDA
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 24
Top = 4320
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtQU
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 23
Top = 3960
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSB
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 25
Top = 4680
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtMN
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 22
Top = 3600
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSM
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 21
Top = 3240
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSA
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 20
Top = 2880
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtPrimRate
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 19
Top = 2520
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtMetal
Alignment = 1 'Right Justify
Height = 315
Left = 6420
MaxLength = 9
TabIndex = 18
Top = 2160
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtPhone
Alignment = 1 'Right Justify
Height = 285
Left = 6420
MaxLength = 10
TabIndex = 16
Top = 1440
Width = 1575
End
Begin VB.TextBox txtCrewBoss
Height = 315
Left = 6060
MaxLength = 30
TabIndex = 15
Top = 1020
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 = "frmCrews.frx":0000
Left = 3180
List = "frmCrews.frx":0019
Style = 2 'Dropdown List
TabIndex = 2
Top = 75
Width = 1755
End
Begin VB.ListBox lstCrew
Height = 7275
Left = 60
Sorted = -1 'True
TabIndex = 0
Top = 495
Width = 4875
End
Begin VB.Label lblPrintInfo
Caption = $"frmCrews.frx":005C
ForeColor = &H000000FF&
Height = 1230
Left = 7590
TabIndex = 36
Top = 2970
Visible = 0 'False
Width = 1785
End
Begin VB.Label lblEndDate
AutoSize = -1 'True
Caption = "Ending Print Date:"
Height = 195
Left = 7605
TabIndex = 32
Top = 2415
Visible = 0 'False
Width = 1290
End
Begin VB.Label lblBegDate
AutoSize = -1 'True
Caption = "Beginning Print Date:"
Height = 195
Left = 7605
TabIndex = 31
Top = 1845
Visible = 0 'False
Width = 1500
End
Begin VB.Label lblEmpNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Employee No:"
Height = 195
Left = 5340
TabIndex = 30
Top = 1860
Width = 990
End
Begin VB.Label lblInstructions
Caption = $"frmCrews.frx":00F7
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1515
Left = 5220
TabIndex = 29
Top = 6120
Width = 4155
End
Begin VB.Label lblDA
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Dash Rate:"
Height = 195
Left = 5550
TabIndex = 14
Top = 4380
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 = 6420
TabIndex = 13
Top = 600
Width = 975
End
Begin VB.Label lblQU
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quernavaca Rate:"
Height = 195
Left = 5040
TabIndex = 12
Top = 4020
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblSB
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Synthetic Rate:"
Height = 195
Left = 5265
TabIndex = 11
Top = 4740
Visible = 0 'False
Width = 1095
End
Begin VB.Label lblMN
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Monterrey Rate:"
Height = 195
Left = 5220
TabIndex = 10
Top = 3615
Visible = 0 'False
Width = 1140
End
Begin VB.Label lblSmooth
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Smooth Rate:"
Height = 195
Left = 5385
TabIndex = 9
Top = 3330
Visible = 0 'False
Width = 975
End
Begin VB.Label lblSand
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sand Rate:"
Height = 195
Left = 5550
TabIndex = 8
Top = 2970
Visible = 0 'False
Width = 810
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 5535
TabIndex = 7
Top = 2265
Visible = 0 'False
Width = 825
End
Begin VB.Label lblPrimRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Rate:"
Height = 195
Left = 5610
TabIndex = 6
Top = 2625
Visible = 0 'False
Width = 750
End
Begin VB.Label lblPhone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Phone #:"
Height = 195
Left = 5700
TabIndex = 5
Top = 1500
Width = 660
End
Begin VB.Label lblName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Leader:"
Height = 195
Left = 5055
TabIndex = 4
Top = 1080
Width = 945
End
Begin VB.Label lblCrewNum
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew #:"
Height = 195
Left = 5805
TabIndex = 3
Top = 660
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 = "frmCrews"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSCREW As Recordset
Dim mintCREW As Integer
Dim mboolAdding As Boolean
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 cmdAdd_Click()
cmdAdd.Enabled = False
cmdSave.Enabled = True
mboolAdding = True
Call FormClear
txtCrewBoss.SetFocus
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 Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
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
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)
' 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)
' strLine = Format(Field2Str(oRS!Crew_Boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!Crew_ID)
Else
strLine = Format(Field2Str(oRS!Crew_Boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!Crew_ID)
' 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 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
' adOpenKeyset , 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 Sub FormShowCrew()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
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")
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
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 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 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 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 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