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/frmRepair.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

1603 lines
44 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmRepair
Caption = "Repair Schedule"
ClientHeight = 8850
ClientLeft = 60
ClientTop = 345
ClientWidth = 11850
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 8850
ScaleWidth = 11850
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtSeq
Alignment = 1 'Right Justify
Height = 315
Left = 1020
TabIndex = 68
Top = 8220
Width = 615
End
Begin VB.TextBox txtWorkers
Height = 315
Left = 6300
TabIndex = 20
Top = 4980
Width = 1095
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Repair"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 10620
TabIndex = 63
Top = 3480
Width = 1200
End
Begin Crystal.CrystalReport crRepair
Left = 2640
Top = 7800
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "&Print Daily Sheet"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9300
TabIndex = 62
Top = 3480
Width = 1275
End
Begin VB.CommandButton cmdGetLot
Caption = "&Get Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 7980
TabIndex = 61
Top = 3480
Width = 1275
End
Begin VB.ListBox lstProject
Height = 2595
Left = 7080
Sorted = -1 'True
TabIndex = 60
Top = 600
Visible = 0 'False
Width = 4695
End
Begin VB.ListBox lstLot
Height = 2790
Left = 7080
Sorted = -1 'True
TabIndex = 59
Top = 600
Visible = 0 'False
Width = 4695
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4020
TabIndex = 58
Top = 3480
Width = 1275
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6660
TabIndex = 57
Top = 3480
Width = 1275
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5340
TabIndex = 56
Top = 3480
Width = 1275
End
Begin VB.ComboBox cboDArea
Height = 315
ItemData = "frmRepair.frx":0000
Left = 1020
List = "frmRepair.frx":0022
Style = 2 'Dropdown List
TabIndex = 14
Top = 7860
Width = 1215
End
Begin VB.TextBox txtNotes
Height = 1335
Left = 4080
MultiLine = -1 'True
TabIndex = 31
Top = 7380
Width = 7635
End
Begin VB.TextBox txtDesc
Height = 1035
Left = 4080
MaxLength = 250
MultiLine = -1 'True
TabIndex = 30
Top = 6180
Width = 5595
End
Begin VB.TextBox txtBPhone
Height = 315
Left = 960
MaxLength = 14
TabIndex = 11
Top = 5700
Width = 1215
End
Begin VB.TextBox txtEstTime
Alignment = 1 'Right Justify
Height = 315
Left = 8400
MaxLength = 3
TabIndex = 22
Top = 5340
Width = 1215
End
Begin VB.TextBox txtStory
Alignment = 1 'Right Justify
Height = 315
Left = 8400
MaxLength = 1
TabIndex = 21
Top = 4980
Width = 1215
End
Begin VB.TextBox txtBCWho
Height = 315
Left = 6120
MaxLength = 20
TabIndex = 23
Top = 5700
Width = 3495
End
Begin VB.Frame frmRepair
Caption = "Work Type"
Height = 2295
Left = 9840
TabIndex = 36
Top = 4260
Width = 1875
Begin VB.CheckBox chkBC
Caption = "Back Charge:"
Height = 375
Left = 300
TabIndex = 29
Top = 1800
Width = 1400
End
Begin VB.CheckBox chkWarrenty
Caption = "Warranty:"
Height = 315
Left = 300
TabIndex = 28
Top = 1500
Width = 1400
End
Begin VB.CheckBox chkWO
Caption = "WorkOrder:"
Height = 315
Left = 300
TabIndex = 27
Top = 1200
Width = 1400
End
Begin VB.CheckBox chkYr2
Caption = "2nd Year End:"
Height = 375
Left = 300
TabIndex = 26
Top = 840
Width = 1400
End
Begin VB.CheckBox chkYr1
Caption = "1st Year End:"
Height = 315
Left = 300
TabIndex = 25
Top = 540
Width = 1400
End
Begin VB.CheckBox chkPunch
Caption = "Punch:"
Height = 255
Left = 300
TabIndex = 24
Top = 240
Width = 1400
End
End
Begin VB.TextBox txtVWPSuper
Height = 315
Left = 8400
MaxLength = 14
TabIndex = 18
Top = 4260
Width = 1215
End
Begin VB.TextBox txtHPhone
Height = 315
Left = 3300
MaxLength = 14
TabIndex = 17
Top = 4980
Width = 1215
End
Begin VB.TextBox txtHAddress
Height = 315
Left = 3300
MaxLength = 30
TabIndex = 16
Top = 4620
Width = 3315
End
Begin VB.TextBox txtHName
Height = 315
Left = 3300
MaxLength = 20
TabIndex = 15
Top = 4260
Width = 3315
End
Begin VB.TextBox txtBillAmt
Alignment = 1 'Right Justify
Height = 315
Left = 960
MaxLength = 10
TabIndex = 34
Top = 7500
Width = 1215
End
Begin VB.TextBox txtBillDate
Height = 315
Left = 960
MaxLength = 10
TabIndex = 33
Top = 7140
Width = 1215
End
Begin VB.CheckBox chkBilled
Alignment = 1 'Right Justify
Caption = "Billed:"
Height = 195
Left = 420
TabIndex = 32
Top = 6840
Width = 1035
End
Begin VB.TextBox txtBPOAmt
Alignment = 1 'Right Justify
Height = 315
Left = 960
MaxLength = 10
TabIndex = 13
Top = 6420
Width = 1215
End
Begin VB.TextBox txtBPO
Height = 315
Left = 960
MaxLength = 15
TabIndex = 12
Top = 6060
Width = 1215
End
Begin VB.TextBox txtBContact
Height = 315
Left = 960
MaxLength = 20
TabIndex = 10
Top = 5340
Width = 2175
End
Begin VB.TextBox txtCompleted
Height = 315
Left = 960
MaxLength = 10
TabIndex = 9
Top = 4620
Width = 1215
End
Begin VB.TextBox txtScheduled
Height = 315
Left = 960
MaxLength = 10
TabIndex = 8
Top = 4260
Width = 1215
End
Begin VB.ComboBox cboArea
Height = 315
ItemData = "frmRepair.frx":0073
Left = 4260
List = "frmRepair.frx":0095
Style = 2 'Dropdown List
TabIndex = 5
TabStop = 0 'False
Top = 120
Width = 1155
End
Begin VB.ListBox lstRepair
Height = 2790
Left = 180
TabIndex = 3
TabStop = 0 'False
Top = 600
Width = 6795
End
Begin VB.ComboBox cboRCrew
Height = 315
Left = 7200
Style = 2 'Dropdown List
TabIndex = 19
Top = 4620
Width = 2415
End
Begin MSComCtl2.DTPicker dtpRepairs
Height = 315
Left = 1020
TabIndex = 0
TabStop = 0 'False
Top = 120
Width = 1515
_ExtentX = 2672
_ExtentY = 556
_Version = 393216
Format = 94961665
CurrentDate = 40544
MaxDate = 55153
MinDate = 36892
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sequence:"
Height = 195
Left = 60
TabIndex = 67
Top = 8280
Width = 780
End
Begin VB.Label lblWorkers
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "# of Workers:"
Height = 195
Left = 5160
TabIndex = 66
Top = 5040
Width = 975
End
Begin VB.Label lblLot
BackStyle = 0 'Transparent
Height = 255
Left = 2880
TabIndex = 65
Top = 3840
Width = 675
End
Begin VB.Label lblProject
Height = 255
Left = 180
TabIndex = 64
Top = 3840
Width = 2535
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Area:"
Height = 195
Left = 465
TabIndex = 55
Top = 7980
Width = 375
End
Begin VB.Label lblAreaDef
Caption = "Nothing in the 'List Area' will display all repairs for the selected Date:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5520
TabIndex = 54
Top = 60
Width = 4335
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Notes:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3360
TabIndex = 53
Top = 7440
Width = 690
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description of Work:"
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 = 2280
TabIndex = 52
Top = 6240
Width = 1770
End
Begin VB.Label lblBPhone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Phone:"
Height = 195
Left = 330
TabIndex = 51
Top = 5760
Width = 510
End
Begin VB.Label lblEstTime
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "# of Minutes to Complete Repair:"
Height = 195
Left = 6060
TabIndex = 50
Top = 5400
Width = 2325
End
Begin VB.Label lblStory
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "# of Stories:"
Height = 195
Left = 7530
TabIndex = 49
Top = 5100
Width = 855
End
Begin VB.Label lblBCWho
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Back Charge Who:"
Height = 195
Left = 4680
TabIndex = 48
Top = 5820
Width = 1365
End
Begin VB.Label lblVWPSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP Superintendent:"
Height = 195
Left = 6840
TabIndex = 47
Top = 4380
Width = 1545
End
Begin VB.Label lblHPhone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Telephone:"
Height = 195
Left = 2385
TabIndex = 46
Top = 5100
Width = 810
End
Begin VB.Label lblHAddress
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Address:"
Height = 195
Left = 2580
TabIndex = 45
Top = 4740
Width = 615
End
Begin VB.Label lblHName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Name:"
Height = 195
Left = 2730
TabIndex = 44
Top = 4380
Width = 465
End
Begin VB.Label lblBillDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Billed Date:"
Height = 195
Left = 30
TabIndex = 43
Top = 7260
Width = 810
End
Begin VB.Label lblBillAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Billed Amt:"
Height = 195
Left = 105
TabIndex = 42
Top = 7620
Width = 735
End
Begin VB.Label lblHOInfo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Homeowner Information:"
Height = 195
Left = 3360
TabIndex = 41
Top = 4020
Width = 1725
End
Begin VB.Label lblBAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Amount:"
Height = 195
Left = 255
TabIndex = 40
Top = 6540
Width = 585
End
Begin VB.Label lblBPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "P.O.:"
Height = 195
Left = 480
TabIndex = 39
Top = 6180
Width = 360
End
Begin VB.Label lblBContact
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contact:"
Height = 195
Left = 240
TabIndex = 38
Top = 5460
Width = 600
End
Begin VB.Label lblBuilderInfo
AutoSize = -1 'True
Caption = "Builder Information:"
Height = 195
Left = 840
TabIndex = 37
Top = 5040
Width = 1350
End
Begin VB.Label lblCompleted
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Completed:"
Height = 195
Left = 135
TabIndex = 35
Top = 4740
Width = 795
End
Begin VB.Label lblScheduled
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scheduled:"
Height = 195
Left = 120
TabIndex = 7
Top = 4380
Width = 810
End
Begin VB.Label lblProjectLot
BorderStyle = 1 'Fixed Single
Height = 315
Left = 180
TabIndex = 6
Top = 3480
Width = 3735
End
Begin VB.Label lblArea
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "List Area:"
Height = 195
Left = 3435
TabIndex = 4
Top = 180
Width = 660
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 6720
TabIndex = 2
Top = 4740
Width = 405
End
Begin VB.Label lblRDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Repair Date:"
Height = 195
Left = 60
TabIndex = 1
Top = 180
Width = 900
End
End
Attribute VB_Name = "frmRepair"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSRepair As Recordset
Dim moRS As Recordset, moRSProj As Recordset
Dim mboolSHOW As Boolean, mboolAdding As Boolean
Dim mlngREPAIRID As Long, mintBOOKMARK As Integer
Dim mstrPROJLOT As String
Private Sub RepairLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
If cboArea.ListIndex = -1 Then
strSQL = "SELECT repair_ID, sequence, proj_lot, lot_id, area, punch, yrend1, yrend2, wo, repair from tblRepair WHERE scheduled = #" & CDate(dtpRepairs.Value) & "# ORDER BY Area, sequence"
Else
strSQL = "SELECT Repair_ID, sequence, proj_lot, lot_id, area, punch, yrend1, yrend2, wo, repair from tblRepair WHERE scheduled = #" & CDate(dtpRepairs.Value) & "# and Area = '" & Left(cboArea.Text, 1) & "' ORDER BY sequence"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstRepair.Clear
Do Until oRS.EOF
With lstRepair
gintLOTID = Field2Str2(oRS!Lot_id)
'Call GetLotInfo
If oRS!punch Then
strTYPE = "PUNCH "
ElseIf oRS!yrend1 Then
strTYPE = "1 YEAR END"
ElseIf oRS!yrend2 Then
strTYPE = "2 YEAR END"
ElseIf oRS!wo Then
strTYPE = "PO WORK "
ElseIf oRS!repair Then
strTYPE = "REPAIR "
End If
strLine = ""
strLine = Field2Str(oRS!Area) & " " & Field2Str(oRS!sequence) & vbTab
strLine = strLine & strTYPE & vbTab & Field2Str(oRS!proj_lot)
' strLine = strLine & Format(oRS!builder_phone, "???????????") & vbTab & oRS!builder_contact & vbTab & mstrPROJLOT
' strline = str
' strLine = oRS!lot_id '& vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!repair_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstRepair.ListCount Then
lstRepair.ListIndex = 0
mlngREPAIRID = lstRepair.ItemData(lstRepair.ListIndex)
Else
mlngREPAIRID = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module RepairLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim oRSRCrew As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT RC_ID, Name FROM tblRCrew"
Set oRSRCrew = New Recordset
oRSRCrew.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
Do Until oRSRCrew.EOF
cboRCrew.AddItem oRSRCrew("Name")
cboRCrew.ItemData(cboRCrew.NewIndex) = Field2Long(oRSRCrew("RC_ID"))
oRSRCrew.MoveNext
Loop
oRSRCrew.Close
' cboRCrew.ListIndex = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cboArea_Click()
Call RepairLoad
End Sub
Private Sub cboArea_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
cboArea.ListIndex = -1
End If
End Sub
Private Sub cmdAdd_Click()
mboolAdding = True
Call FormClear
Call ProjectSelect
cmdExit.Caption = "&Cancel"
cmdExit.Enabled = True
cmdSave.Enabled = True
lstRepair.Enabled = False
lstProject.SetFocus
End Sub
Private Sub cmdDelete_Click()
Dim strSQL As String, strYN As String
On Error GoTo Error_EH
If Len(txtCompleted) <> 0 Then
MsgBox "This Repair Can Not Be Deleted", vbOKOnly, "NO DELETE ALLOWED"
Exit Sub
End If
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
gconACTION = 3
strSQL = "DELETE * FROM tblrepair WHERE repair_id = " & lstRepair.ItemData(lstRepair.ListIndex)
goConn.Execute strSQL
' strSQL = "DELETE * FROM tblLotMatrl WHERE Lot_id = " & gintLOTID
' goConn.Execute strSQL
' moRS.Delete
gstrFLAG = "D"
Call LotChange(mstrPROJLOT, "Delete Repair")
Call RepairLoad
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module cmdDelete"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdGetLot_Click()
Call GetLotInfo
Call cmdSave_Click
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String
On Error GoTo Error_EH
If Len(cboArea.Text) = 0 Then
MsgBox "You Must Select A Value In The 'List Area' Field", vbOKOnly, "No Area Of Town Selected"
Exit Sub
End If
strMONTH = Format(Month(dtpRepairs.Value), "00")
strDAY = Format(Day(dtpRepairs.Value), "00")
strYEAR = Year(dtpRepairs.Value)
gintPRINT = 1
frmReport.Show 1
strSQL = "{tblREPAIR.scheduled} = date(" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'"
crREPAIR.ReportFileName = App.Path & "\DailyRepairs.rpt"
crREPAIR.SelectionFormula = strSQL
' crRepair.Destination = crptToWindow
crREPAIR.CopiesToPrinter = gintCOPY
crREPAIR.Destination = gintDEST
crREPAIR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstRepair.ListIndex
If Len(cboDArea.Text) = 0 Then
MsgBox "You Must Enter The Area Of Town Before Saving", vbOKOnly, "Select An Area"
cboDArea.SetFocus
Exit Sub
End If
Call FormSave
cmdSave.Enabled = False
cmdAdd.Enabled = True
lstRepair.Enabled = True
If lstRepair.ListIndex > 0 Then
lstRepair.ListIndex = mintBOOKMARK
End If
End Sub
Private Sub dtpRepairs_Change()
Call RepairLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
' mboolSETUP = False
' mboolENTER = False
' If gintLOTID = 0 Then
' intResponse = MsgBox("No Lot Information, do you wish to add one?", vbYesNo + vbQuestion, "Add Lot Information")
' If intResponse = vbYes Then
' txtProject = Trim$(moRSProj!proj_code) & " " & moRSProj!proj_desc
' strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = 1"
' Set moRS = New Recordset
' moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' Call cmdAddLot_Click
' Else
' Unload Me
' End If
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
' If Field2Str(moRS!l_flg) <> "P" Then
' If Not cmdSaveLotInfo.Enabled Then
' Call DataHasChanged
' End If
' 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()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
Set moRSRepair = New Recordset
dtpRepairs.Value = Date
Call CrewLoad
Call RepairLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String, strMEMO As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblRepair "
strSQL = strSQL & "WHERE Repair_ID = " & mlngREPAIRID
If moRSRepair.State = adStateOpen Then
moRSRepair.Close
End If
Set moRSRepair = New Recordset
moRSRepair.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSRepair.EOF Then
FormFind = False
Else
FormFind = True
gintLOTID = Field2Str2(moRSRepair!Lot_id)
gintPROJID = Field2Str2(moRSRepair!Proj_ID)
End If
Exit Function
Error_EH:
gstrMODULE = "Form Repair - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShow()
Dim mstrAREA As String
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
lblProject.Caption = ""
lblLot.Caption = ""
mboolSHOW = True
strSQL = "Select Proj_Desc FROM tblProject WHERE proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lblProject.Caption = Field2Str(oRS!Proj_Desc)
strSQL = "Select Lot_no FROM tblLotInfo WHERE Lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lblLot.Caption = Field2Str(oRS!lot_no)
With moRSRepair
txtScheduled = Field2Str(!scheduled)
txtCompleted = Field2Str(!completed)
txtBContact = Field2Str(!builder_contact)
txtBPhone = Field2Str(!builder_phone)
txtBPO = Field2Str(!builder_PO)
txtBPOAmt = Field2Str(!PO_Amt)
txtBillDate = Field2Str(!bill_date)
txtBillAmt = Field2Str(!bill_amt)
txtHName = Field2Str(!Owner_Name)
txtHAddress = Field2Str(!Owner_address)
txtSeq = Field2Str2(!sequence)
txtHPhone = Field2Str(!Owner_phone)
txtVWPSuper = Field2Str(!VWP_Super)
txtStory = Field2Str(!storys)
txtEstTime = Field2Str(!est_time)
txtBCWho = Field2Str(!bc_who)
txtDesc = Field2Str(!Desc)
txtNotes = Field2Str(!notes)
txtWorkers = Field2Str(!crewsize)
mstrAREA = Field2Str(!Area)
If mstrAREA = "W" Then
cboDArea.Text = "West"
ElseIf mstrAREA = "N" Then
cboDArea.Text = "North"
ElseIf mstrAREA = "S" Then
cboDArea.Text = "South"
ElseIf mstrAREA = "X" Then
cboDArea.Text = "Xtra"
ElseIf mstrAREA = "2" Then
cboDArea.Text = "2-North"
ElseIf mstrAREA = "3" Then
cboDArea.Text = "3-North"
ElseIf mstrAREA = "4" Then
cboDArea.Text = "4-South"
ElseIf mstrAREA = "5" Then
cboDArea.Text = "5-West"
ElseIf mstrAREA = "6" Then
cboDArea.Text = "6-Stone"
ElseIf mstrAREA = "P" Then
cboDArea.Text = "Paint"
End If
chkBilled = Field2CheckBox(!billed)
chkPunch = Field2CheckBox(!punch)
chkYr1 = Field2CheckBox(!yrend1)
chkYr2 = Field2CheckBox(!yrend2)
chkWO = Field2CheckBox(!wo)
chkWarrenty = Field2CheckBox(!repair)
chkBC = Field2CheckBox(!backcharge)
cboRCrew.ListIndex = Field2Integer(!repair_crew) - 1
lblProjectLot.Caption = Field2Str(!proj_lot)
' cboRCrew.ListIndex = Field2Long(!repair_crew)
End With
' Call GetLotInfo
mboolSHOW = False
Exit Sub
Error_EH:
If Err = 3021 Then
MsgBox "No Project Was Found = Be Sure To Click The Get Lot Button", vbOKOnly, "No Project"
Resume Next
End If
gstrMODULE = "Form Repair - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strLOT As String
On Error GoTo Error_EH
If mboolAdding Then
moRSRepair.AddNew
moRSRepair!createuser = gstrLOGIN
moRSRepair!Proj_ID = gintPROJID
moRSRepair!Lot_id = gintLOTID
moRSRepair!proj_lot = Field2Str(lblProjectLot.Caption)
End If
With moRSRepair
!scheduled = Str2Field(txtScheduled)
!completed = Str2Field(txtCompleted)
!builder_contact = Str2Field(txtBContact)
!builder_phone = Str2Field(txtBPhone)
!builder_PO = Str2Field(txtBPO)
!PO_Amt = Str2Field(txtBPOAmt)
!bill_date = Str2Field(txtBillDate)
!bill_amt = Str2Field(txtBillAmt)
!Owner_Name = Str2Field(txtHName)
!Owner_address = Str2Field(txtHAddress)
!Owner_phone = Str2Field(txtHPhone)
!VWP_Super = Str2Field(txtVWPSuper)
!storys = Str2Field(txtStory)
!est_time = Str2Field(txtEstTime)
!bc_who = Str2Field(txtBCWho)
!Desc = Str2Field(txtDesc)
!crewsize = Str2Field(txtWorkers)
!notes = Str2Field(txtNotes)
!sequence = Str2Field(txtSeq)
!Area = Left((cboDArea.Text), 1)
!billed = chkBilled
!punch = chkPunch
!yrend1 = chkYr1
!yrend2 = chkYr2
!wo = chkWO
!repair = chkWarrenty
!backcharge = chkBC
!repair_crew = (cboRCrew.ListIndex + 1)
!UpdateUser = gstrLOGIN
!Updated = Date
!proj_lot = lblProjectLot.Caption
!Proj_ID = gintPROJID
End With
moRSRepair.Update
If mboolAdding Then
Call RepairLoad
' Call PlanMatLoad
' Call POptLoad
If FormFind() Then
Call FormShow 'xxxxxxxxxxxxxxxxxx
Else
Call FormClear
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"
' strLOT = InputBox("Enter a New Lot Number", "Fix Duplicate")
' If Len(strLOT) > 0 Then
' moRS!lot_no = Field2Str(strLOT)
' moRS.Update
' txtLotNo = Field2Str(strLOT)
' End If
Resume Next
End If
gstrMODULE = "Form Repair - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtScheduled = ""
txtBContact = ""
txtBPhone = ""
txtBPO = ""
txtBPOAmt = 0
txtBillDate = ""
txtBillAmt = 0
txtHName = ""
txtHAddress = ""
txtHPhone = ""
txtVWPSuper = ""
txtBCWho = ""
txtDesc = ""
txtNotes = ""
cboDArea.ListIndex = -1
chkBilled = vbUnchecked
chkWO = vbUnchecked
chkWarrenty = vbUnchecked
chkBC = vbUnchecked
cboRCrew.ListIndex = -1
lblProjectLot = ""
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' If mboolAdding Then
' moRSRepair.AddNew
' moRSRepair!proj_id = gintPROJID
' moRSRepair!lot_id = gintLOTID
' moRSRepair!proj_lot = mstrPROJLOT
' End If
' Store the controls to the recordset
Call FieldsSave
moRSRepair.Update
If mboolAdding Then
mboolAdding = False
End If
Call RepairLoad
Exit Sub
Error_EH:
Call ErrorHandler(moRSRepair.ActiveConnection)
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If moRSRepair.State = adStateOpen Then
moRSRepair.Close
End If
End Sub
Private Sub lstLot_DblClick()
Dim lngPOS As Long, strSQL As String
Dim oRS As Recordset
lngPOS = InStr(1, lstLot.Text, vbTab, 1)
gintLOTID = lstLot.ItemData(lstLot.ListIndex)
mstrPROJLOT = mstrPROJLOT & " - " & Left(lstLot.Text, lngPOS - 1)
lblProjectLot = mstrPROJLOT
strSQL = "SELECT owner, address, lot_id FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' moRS.MovePrevious
txtHName = Field2Str(oRS!Owner)
txtHAddress = Field2Str(oRS!address)
lstLot.Visible = False
End Sub
Private Sub lstProject_DblClick()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
mstrPROJLOT = lstProject.Text
lstProject.Visible = False
Call LotSelect
lstLot.SetFocus
End Sub
Private Sub lstRepair_Click()
On Error GoTo Error_EH
If lstRepair.ListIndex <> -1 Then
mlngREPAIRID = lstRepair.ItemData(lstRepair.ListIndex)
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module lstRepair_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstRepair_DblClick()
cmdAdd.Enabled = False
cmdSave.Enabled = True
End Sub
Private Sub txtBContact_GotFocus()
Call FieldSelect(txtBContact)
End Sub
Private Sub txtBContact_LostFocus()
txtBContact = UCase(txtBContact)
End Sub
Private Sub txtBCWho_GotFocus()
Call FieldSelect(txtBCWho)
End Sub
Private Sub txtBCWho_LostFocus()
txtBCWho = UCase(txtBCWho)
End Sub
Private Sub txtBillAmt_GotFocus()
Call FieldSelect(txtBillAmt)
End Sub
Private Sub txtBillDate_GotFocus()
Call FieldSelect(txtBillDate)
End Sub
Private Sub txtBillDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtBillDate, "/", 1)
If lngPOS = 0 Then
If Len(txtBillDate) > 0 Then
txtBillDate = Format(txtBillDate, "00/00/####")
If Not IsDate(txtBillDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtBillDate.SetFocus
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtBillDate.SetFocus
End If
End Sub
Private Sub txtBPhone_GotFocus()
Call FieldSelect(txtBPhone)
End Sub
Private Sub txtBPO_GotFocus()
Call FieldSelect(txtBPO)
End Sub
Private Sub txtBPOAmt_GotFocus()
Call FieldSelect(txtBPOAmt)
End Sub
Private Sub txtCompleted_GotFocus()
Call FieldSelect(txtCompleted)
End Sub
Private Sub txtCompleted_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtCompleted, "/", 1)
If lngPOS = 0 Then
If Len(txtCompleted) > 0 Then
txtCompleted = Format(txtCompleted, "00/00/####")
If Not IsDate(txtCompleted) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtCompleted.SetFocus
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtCompleted.SetFocus
End If
End Sub
Private Sub txtDesc_GotFocus()
' Call FieldSelect(txtDesc)
End Sub
Private Sub txtDesc_LostFocus()
txtDesc = UCase(txtDesc)
End Sub
Private Sub txtEstTime_GotFocus()
Call FieldSelect(txtEstTime)
End Sub
Private Sub txtHAddress_GotFocus()
Call FieldSelect(txtHAddress)
End Sub
Private Sub txtHAddress_LostFocus()
txtHAddress = UCase(txtHAddress)
End Sub
Private Sub txtHName_GotFocus()
Call FieldSelect(txtHName)
End Sub
Private Sub txtHName_LostFocus()
txtHName = UCase(txtHName)
End Sub
Private Sub txtHPhone_GotFocus()
Call FieldSelect(txtHPhone)
End Sub
Private Sub txtNotes_GotFocus()
' txtNotes.MaxLength = Len(txtNotes)
' Call FieldSelect(txtNotes)
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
End Sub
Private Sub txtScheduled_GotFocus()
Call FieldSelect(txtScheduled)
End Sub
Private Sub txtScheduled_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtScheduled, "/", 1)
If lngPOS = 0 Then
If Len(txtScheduled) > 0 Then
txtScheduled = Format(txtScheduled, "00/00/####")
If Not IsDate(txtScheduled) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScheduled.SetFocus
End If
End If
Else
If Not IsDate(txtScheduled) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScheduled.SetFocus
Else
Exit Sub
End If
End If
End Sub
Private Sub txtStory_GotFocus()
Call FieldSelect(txtStory)
End Sub
Private Sub txtVWPSuper_GotFocus()
Call FieldSelect(txtVWPSuper)
End Sub
Private Sub txtVWPSuper_LostFocus()
txtVWPSuper = UCase(txtVWPSuper)
End Sub
Private Sub GetLotInfo()
Dim strSQL As String, strSELECT As String
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
If Not moRS.EOF Then
strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Long(moRS!Proj_ID)
' strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Integer(moRS!proj_id)
Set moRSProj = New Recordset
moRSProj.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic
End If
gintPROJID = moRSProj!Proj_ID
mstrPROJLOT = Trim(Field2Str(moRSProj!Proj_Desc)) & " - " & Trim(Field2Str(moRS!lot_no))
lblProjectLot = mstrPROJLOT
If moRS!TWOSTORY = True Then
txtStory = 2
Else
txtStory = 1
End If
End Sub
Private Sub LotSelect()
Dim strSQL As String, strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_no, address, owner, lot_id FROM tblLotInfo WHERE proj_id = " & gintPROJID
Set moRS = New Recordset
moRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstLot.Visible = True
lstLot.Clear
Do Until moRS.EOF
strLine = ""
strLine = Field2Str(moRS!lot_no) & vbTab & Field2Str(moRS!address)
lstLot.AddItem strLine
lstLot.ItemData(lstLot.NewIndex) = Field2Long(moRS!Lot_id)
moRS.MoveNext
Loop
' cboRCrew.ListIndex = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module LotSelect"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjectSelect()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT Proj_id, Proj_Desc FROM tblProject"
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstProject.Visible = True
lstProject.Clear
Do Until oRS.EOF
lstProject.AddItem oRS!Proj_Desc
lstProject.ItemData(lstProject.NewIndex) = Field2Long(oRS!Proj_ID)
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module ProjectSelect"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
'Public Sub LotChange(strProjLot As String, strAction As String)
'
' Load frmChange
' frmChange.lblProjLot = strProjLot
' frmChange.lblAction = strAction
'
' frmChange.Show 1
'
'End Sub
Reference in New Issue View Git Blame Copy Permalink