Files
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

1467 lines
42 KiB
Plaintext

VERSION 5.00
Begin VB.Form frmProject
Caption = "Project Information"
ClientHeight = 7950
ClientLeft = 60
ClientTop = 345
ClientWidth = 12120
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 7950
ScaleWidth = 12120
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkPulteSW
Caption = "Pulte Super Wall"
Height = 225
Left = 10200
TabIndex = 70
Top = 1440
Width = 1500
End
Begin VB.CheckBox chkPaintInv
Caption = "2 Paint Invoices"
Height = 255
Left = 10200
TabIndex = 69
Top = 1185
Width = 1785
End
Begin VB.CheckBox chkPulte
Caption = "Pulte Special Calc"
Height = 210
Left = 10200
TabIndex = 68
Top = 975
Width = 1755
End
Begin VB.TextBox txtConId
Alignment = 1 'Right Justify
BackColor = &H80000004&
BorderStyle = 0 'None
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 = 285
Left = 3570
TabIndex = 66
Top = 1215
Width = 570
End
Begin VB.CheckBox chkSYN
Caption = "Full Synthetic"
Height = 285
Left = 10200
TabIndex = 65
Top = 690
Width = 1620
End
Begin VB.TextBox txtProjId
Alignment = 1 'Right Justify
BackColor = &H80000004&
BorderStyle = 0 'None
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 = 300
Left = 3555
TabIndex = 64
Top = 840
Width = 570
End
Begin VB.CheckBox chkShowAll
Caption = "Show All Projects"
Height = 210
Left = 5175
TabIndex = 63
Top = 6300
Width = 1695
End
Begin VB.CheckBox chkINACTIVE
Caption = "Inactive Project"
Height = 270
Left = 3720
TabIndex = 62
Top = 6255
Width = 1485
End
Begin VB.CheckBox chk2Dates
Caption = "Two Dates"
Height = 345
Left = 6990
TabIndex = 61
Top = 4050
Width = 750
End
Begin VB.TextBox txtDue2
Alignment = 2 'Center
Height = 285
Left = 7200
TabIndex = 59
Top = 4845
Width = 555
End
Begin VB.CheckBox chkTYPAR
Caption = "TYPAR Stucco Wrap"
Height = 255
Left = 10200
TabIndex = 58
Top = 465
Width = 1950
End
Begin VB.CheckBox chkBag100
Caption = "75# Bag Sand/PreMix"
Height = 300
Left = 10200
TabIndex = 57
Top = 210
Width = 2025
End
Begin VB.ComboBox cboWire
Height = 315
ItemData = "frmProject.frx":0000
Left = 4200
List = "frmProject.frx":000D
Style = 2 'Dropdown List
TabIndex = 56
Top = 5880
Width = 1755
End
Begin VB.CheckBox chkCertified
Caption = "Certified Payroll"
Height = 315
Left = 6360
TabIndex = 54
Top = 5940
Width = 1395
End
Begin VB.ComboBox cboInvType
Height = 315
ItemData = "frmProject.frx":0034
Left = 5040
List = "frmProject.frx":0047
Style = 2 'Dropdown List
TabIndex = 53
Top = 5520
Width = 2715
End
Begin VB.ComboBox cboCompany
Height = 315
ItemData = "frmProject.frx":008A
Left = 5040
List = "frmProject.frx":0094
Style = 2 'Dropdown List
TabIndex = 51
Top = 5160
Width = 2715
End
Begin VB.TextBox txtBidDue
Height = 315
Left = 5040
TabIndex = 9
Top = 2220
Width = 2655
End
Begin VB.TextBox txtDue
Alignment = 2 'Center
Height = 285
Left = 6600
TabIndex = 20
Top = 4845
Width = 555
End
Begin VB.TextBox txtInv
Height = 315
Left = 9360
MaxLength = 3
TabIndex = 22
Top = 420
Width = 555
End
Begin VB.TextBox txtRetention
Alignment = 1 'Right Justify
Height = 315
Left = 7200
MaxLength = 2
TabIndex = 21
Top = 420
Width = 975
End
Begin VB.TextBox txtSyn_O2
Alignment = 1 'Right Justify
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 = 6180
TabIndex = 14
Top = 3240
Width = 975
End
Begin VB.CheckBox chkOpen
Caption = "Use 50% Openings"
Height = 255
Left = 10200
TabIndex = 25
Top = 15
Width = 1755
End
Begin VB.TextBox txtSYN_O
Alignment = 1 'Right Justify
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 = 6180
TabIndex = 13
Top = 2940
Width = 975
End
Begin VB.TextBox txtSYN_T
Alignment = 1 'Right Justify
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 = 5040
TabIndex = 12
Top = 2940
Width = 975
End
Begin VB.CheckBox chkBill
Caption = "Bill Lath && Stucco Combined"
Height = 255
Left = 7560
TabIndex = 24
Top = 120
Value = 1 'Checked
Width = 2355
End
Begin VB.TextBox txtMAS90JC
Height = 315
Left = 5040
MaxLength = 4
TabIndex = 19
Top = 4800
Width = 1080
End
Begin VB.TextBox txtMAS90AR
Height = 315
Left = 5040
MaxLength = 7
TabIndex = 18
Top = 4500
Width = 1080
End
Begin VB.TextBox txtSWOrder
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "0;(0)"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 1
EndProperty
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 = 315
Left = 6180
TabIndex = 11
Top = 2580
Width = 975
End
Begin VB.CheckBox chkFHA
Caption = "FHA Metal"
Height = 255
Left = 6480
TabIndex = 23
Top = 120
Width = 1155
End
Begin VB.CheckBox chkComplete
Caption = "Project Completed"
Height = 255
Left = 4800
TabIndex = 37
TabStop = 0 'False
Top = 120
Width = 1695
End
Begin VB.CheckBox chkGotBid
Caption = "Got Bid"
Height = 255
Left = 3900
TabIndex = 36
TabStop = 0 'False
Top = 120
Width = 855
End
Begin VB.ListBox lstContractor
Height = 6105
Left = 7800
Sorted = -1 'True
TabIndex = 35
TabStop = 0 'False
Top = 1695
Visible = 0 'False
Width = 4215
End
Begin VB.ComboBox cboStype
Height = 315
ItemData = "frmProject.frx":00B3
Left = 5040
List = "frmProject.frx":00CC
Style = 2 'Dropdown List
TabIndex = 17
Top = 4200
Width = 1935
End
Begin VB.ComboBox cboFType
Height = 315
ItemData = "frmProject.frx":0130
Left = 5040
List = "frmProject.frx":013D
Style = 2 'Dropdown List
TabIndex = 16
Top = 3900
Width = 1935
End
Begin VB.ComboBox cboBP
Height = 315
ItemData = "frmProject.frx":0164
Left = 5040
List = "frmProject.frx":0166
Style = 2 'Dropdown List
TabIndex = 15
Top = 3600
Width = 4995
End
Begin VB.TextBox txtSWAdj
Alignment = 1 'Right Justify
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 = 315
Left = 5040
MaxLength = 4
TabIndex = 10
Top = 2580
Width = 975
End
Begin VB.TextBox txtVWPSuper
Height = 315
Left = 5040
MaxLength = 15
TabIndex = 8
Top = 1860
Width = 2655
End
Begin VB.TextBox txtConSuper
Height = 315
Left = 5040
MaxLength = 15
TabIndex = 7
Top = 1500
Width = 2655
End
Begin VB.TextBox txtContractor
Height = 315
Left = 5040
MaxLength = 30
TabIndex = 6
Top = 1140
Width = 5115
End
Begin VB.TextBox txtDesc
Height = 315
Left = 5040
MaxLength = 30
TabIndex = 5
Top = 780
Width = 5115
End
Begin VB.TextBox txtCode
Height = 315
Left = 5040
MaxLength = 7
TabIndex = 4
Top = 420
Width = 975
End
Begin VB.ListBox lstProject
Height = 7665
Left = 60
Sorted = -1 'True
TabIndex = 1
Top = 240
Width = 3495
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 555
Left = 3660
TabIndex = 3
TabStop = 0 'False
Top = 7200
Width = 1395
End
Begin VB.CommandButton cmdAdd
Caption = "Add"
Height = 555
Left = 5100
TabIndex = 2
TabStop = 0 'False
Top = 6540
Width = 1395
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
Enabled = 0 'False
Height = 555
Left = 5100
TabIndex = 0
TabStop = 0 'False
Top = 7200
Width = 1395
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 555
Left = 3660
TabIndex = 26
Top = 6540
Width = 1395
End
Begin VB.Label lblContractor
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor:"
Height = 195
Left = 4185
TabIndex = 67
Top = 1200
Width = 780
End
Begin VB.Label Label1
Caption = "1 2"
Height = 165
Left = 6810
TabIndex = 60
Top = 4665
Width = 750
End
Begin VB.Label lblWire
AutoSize = -1 'True
Caption = "Wire:"
Height = 195
Left = 3720
TabIndex = 55
Top = 5940
Width = 375
End
Begin VB.Label lblInvType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory Type:"
Height = 195
Left = 3855
TabIndex = 52
Top = 5520
Width = 1110
End
Begin VB.Label lblComp
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Company:"
Height = 195
Left = 4260
TabIndex = 50
Top = 5160
Width = 705
End
Begin VB.Label lblBidDue
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Bid Due Date:"
Height = 195
Left = 3960
TabIndex = 49
Top = 2280
Width = 1005
End
Begin VB.Label lblUDate
BorderStyle = 1 'Fixed Single
Height = 315
Left = 6600
TabIndex = 48
Top = 7440
Width = 3795
End
Begin VB.Label lblUpdate
AutoSize = -1 'True
Caption = "Last Updated:"
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 = 6600
TabIndex = 47
Top = 7200
Width = 1215
End
Begin VB.Label lblCDate
BorderStyle = 1 'Fixed Single
Height = 315
Left = 6600
TabIndex = 46
Top = 6780
Width = 3795
End
Begin VB.Label lblCreate
AutoSize = -1 'True
Caption = "Created:"
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 = 6600
TabIndex = 45
Top = 6540
Width = 735
End
Begin VB.Label lblDue
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Day of Month Due:"
Height = 195
Left = 6435
TabIndex = 44
Top = 4500
Width = 1350
End
Begin VB.Label lblInv
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Code:"
Height = 195
Left = 8280
TabIndex = 43
Top = 480
Width = 990
End
Begin VB.Label lblRetention
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Retention %:"
Height = 195
Left = 6240
TabIndex = 42
Top = 480
Width = 900
End
Begin VB.Label lblSynOpen2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Synthetic Adjust PopOuts:"
Height = 195
Left = 4260
TabIndex = 41
Top = 3360
Width = 1845
End
Begin VB.Label lblSynAdj
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Syn. Adjust T/O:"
Height = 195
Left = 3780
TabIndex = 40
Top = 3000
Width = 1185
End
Begin VB.Label lblMAS90JC
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Job Cost Code:"
Height = 195
Left = 3885
TabIndex = 39
Top = 4860
Width = 1080
End
Begin VB.Label lblMas90AR
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "MAS90 AR Code:"
Height = 195
Left = 3705
TabIndex = 38
Top = 4560
Width = 1260
End
Begin VB.Label lblStuccoType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Type:"
Height = 195
Left = 4005
TabIndex = 34
Top = 4260
Width = 960
End
Begin VB.Label lblFoamType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Foam Type:"
Height = 195
Left = 4125
TabIndex = 33
Top = 3960
Width = 840
End
Begin VB.Label lblBPType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Black Paper Type:"
Height = 195
Left = 3645
TabIndex = 32
Top = 3660
Width = 1320
End
Begin VB.Label lblSWAdj
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "1 Kote Adjust T/O:"
Height = 195
Left = 3630
TabIndex = 31
Top = 2640
Width = 1335
End
Begin VB.Label lblVWPSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP Super:"
Height = 195
Left = 4080
TabIndex = 30
Top = 1920
Width = 885
End
Begin VB.Label lblConSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor Super:"
Height = 195
Left = 3720
TabIndex = 29
Top = 1560
Width = 1245
End
Begin VB.Label lblCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Project Code:"
Height = 195
Left = 4005
TabIndex = 28
Top = 480
Width = 960
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Name:"
Height = 195
Left = 4500
TabIndex = 27
Top = 840
Width = 465
End
End
Attribute VB_Name = "frmProject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSProj As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Dim mboolDelete As Boolean
Private Sub cboWire_GotFocus()
If cboStype.Text <> "Three Coat" Then
cboWire.Text = "One Inch"
End If
End Sub
Private Sub cboWire_LostFocus()
If cboWire.Text = "Paperback" Or cboWire.Text = "Self Furring" Then
If cboStype.Text <> "Three Coat" Then
MsgBox "Paperback and Self Furring are only valid for Three Coat - Select Again", vbOKOnly, "Wrong Wire Type"
cboWire.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub chkComplete_Click()
If Not cmdSave.Enabled Then
cmdSave.Enabled = True
cmdAdd.Enabled = False
End If
End Sub
Private Sub chkFHA_Click()
If Not cmdSave.Enabled Then
cmdSave.Enabled = True
cmdAdd.Enabled = False
End If
End Sub
Private Sub chkGotBid_Click()
If Not cmdSave.Enabled Then
cmdSave.Enabled = True
cmdAdd.Enabled = False
End If
End Sub
Private Sub chkINACTIVE_Click()
' If cmdSave.Enabled = True Then
' cmdSave.Enabled = False
' ElseIf cmdSave.Enabled = False Then
' cmdSave.Enabled = True
' End If
End Sub
Private Sub chkShowAll_Click()
Call ProjectLoad
End Sub
Private Sub cmdAdd_Click()
cmdAdd.Enabled = False
' cmdDelete.Enabled = False
cmdExit.Enabled = False
' cmdFindCont.Visible = True
mboolAdding = True
lstProject.Enabled = False
Call FormClear
End Sub
Private Sub cmdDelete_Click()
mboolDelete = False
Call CheckLots
If mboolDelete = True Then
moRSProj.Delete
End If
Call ProjectLoad
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFindCont_Click()
Call ContractorLoad
lstContractor.Visible = True
End Sub
Private Sub cmdSave_Click()
If Len(txtCode) = 0 Then
MsgBox "A Project Code is required to save"
txtCode.SetFocus
Else
lstProject.Enabled = True
' cmdDelete.Enabled = True
cmdSave.Enabled = False
cmdAdd.Enabled = True
cmdExit.Enabled = True
lstContractor.Visible = False
Call FormSave
lstProject.SetFocus
End If
End Sub
Private Sub Form_Load()
Call ProjectLoad
Call BPLoad
If gbytSECURITY < 3 Then
txtSWAdj.Enabled = True
txtSWOrder.Enabled = True
End If
End Sub
Private Sub ProjectLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
If chkShowAll Then
strSQL = "SELECT Proj_id, Proj_code, Proj_Desc from tblProject" ' WHERE NOT InActive"
Else
strSQL = "SELECT Proj_id, Proj_code, Proj_Desc from tblProject WHERE NOT InActive"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstProject.Clear
Do Until oRS.EOF
With lstProject
strLine = oRS!Proj_Code & vbTab & oRS!Proj_Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!Proj_ID
End With
oRS.MoveNext
Loop
oRS.Close
If lstProject.ListCount Then
lstProject.ListIndex = -1
End If
End Sub
Private Sub FormSave()
Dim intBookmark As Integer
On Error GoTo Error_EH
If mboolAdding Then
moRSProj.AddNew
moRSProj!CUser = gstrLOGIN
moRSProj!pomax = 20
Else
intBookmark = lstProject.ListIndex
End If
Call FieldsSave
moRSProj.Update
If mboolAdding Then
mboolAdding = False
intBookmark = 0
End If
Call ProjectLoad
lstProject.ListIndex = intBookmark
intBookmark = 0
Exit Sub
Error_EH:
Call ErrorHandler(moRSProj.ActiveConnection)
Exit Sub
End Sub
Private Sub BPLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
strSQL = "SELECT BP_Type, Desc from tblBPType"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
cboBP.Clear
Do Until oRS.EOF
With cboBP
strLine = oRS!bp_type & " " & oRS!Desc
.AddItem strLine
End With
oRS.MoveNext
Loop
oRS.Close
If lstProject.ListCount Then
lstProject.ListIndex = 0
End If
End Sub
Private Sub ContractorLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
strSQL = "SELECT cont_id, CONTRCR from tblConInfo WHERE NOT INACTIVE"
' strSQL = "SELECT cont_id, CONTRCR from tblConInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstContractor.Clear
Do Until oRS.EOF
With lstContractor
.AddItem oRS!contrcr
.ItemData(.NewIndex) = oRS!cont_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstContractor.ListCount Then
lstContractor.Visible = True
lstContractor.ListIndex = 0
lstContractor.SetFocus
Else
lstContractor.ListIndex = -1
End If
End Sub
Private Sub FormClear()
txtCode = ""
txtDesc = ""
txtContractor = ""
txtConSuper = ""
txtVWPSuper = ""
txtSWAdj = 0
txtSWOrder = 0
txtSYN_T = 0
txtSYN_O = 0
txtSyn_O2 = 0
chkSYN = vbUnchecked
txtProjId = ""
txtConId = ""
txtRetention = 0
txtMAS90AR = ""
txtMAS90JC = ""
txtInv = ""
txtDue = 1
txtDue2 = 1
chk2Dates = vbUnchecked
chkINACTIVE = vbUnchecked
chkGotBid = vbUnchecked
chkComplete = vbUnchecked
chkFHA = vbUnchecked
chkBill = vbChecked
chkOpen = vbChecked
chkBag100 = vbUnchecked
chkTYPAR = vbUnchecked
chkPulte = vbUnchecked
chkPulteSW = vbUnchecked
chkPaintInv = vbUnchecked
cboBP.ListIndex = -1
cboStype.ListIndex = -1
cboFType.ListIndex = -1
cboWire.ListIndex = -1
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblproject "
strSQL = strSQL & "WHERE proj_id = " & gintPROJID
Set moRSProj = New Recordset
If moRSProj.State = adStateOpen Then
moRSProj.Close
End If
moRSProj.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSProj.EOF Then
FormFind = False
Else
FormFind = True
End If
End Function
Private Sub FieldsSave()
With moRSProj
!Proj_Code = Str2Field(txtCode)
!Proj_Desc = Str2Field(txtDesc)
!Proj_Cont = Str2Field(txtContractor)
!cont_sup = Str2Field(txtConSuper)
!vwp_sup = Str2Field(txtVWPSuper)
!cont_id = Str2Field(txtConId)
!sw_adj = Integer2Field(txtSWAdj)
!sw_order = Double2Field(txtSWOrder)
!gotbid = chkGotBid
!complete = chkComplete
!FHA = chkFHA
!ar = Str2Field(txtMAS90AR)
!biddate = Str2Field(txtBidDue)
!jccode = Str2Field(txtMAS90JC)
!bill = chkBill
!syn_t = Integer2Field(txtSYN_T)
!syn_o = Double2Field(txtSYN_O)
!syn_o2 = Double2Field(txtSyn_O2)
!SYNTHETIC = chkSYN
!use_open = chkOpen
!bag100 = chkBag100
!TYPAR = chkTYPAR
!ftype = Field2Str(Left(cboFType.Text, 1))
!retention = Integer2Field(txtRetention)
!inv = Str2Field(txtInv)
!duedate = Integer2Field(txtDue)
!duedate2 = Integer2Field(txtDue2)
!inactive = Field2CheckBox(chkINACTIVE)
!twodates = Field2CheckBox(chk2Dates)
!Pulte = Field2CheckBox(chkPulte)
!P_SW = Field2CheckBox(chkPulteSW)
!Paint2 = Field2CheckBox(chkPaintInv)
!UUser = gstrLOGIN
!certpr = chkCertified
!Update = Now()
If cboStype.Text = "Superwall" Then
!stype = "S"
ElseIf cboStype.Text = "Pre-Mix Stucco" Then
!stype = "M"
ElseIf cboStype.Text = "Three Coat" Then
!stype = "T"
ElseIf cboStype.Text = "Synthetic" Then
!stype = "C"
ElseIf cboStype.Text = "Synthetic w/ 1 Kote" Then
!stype = "B"
ElseIf cboStype.Text = "San Man" Then
!stype = "N"
ElseIf cboStype.Text = "Western 1 Kote" Then
!stype = "W"
End If
If cboWire.Text = "Paperback" Then
!wire = "P"
ElseIf cboWire.Text = "Self Furring" Then
!wire = "F"
ElseIf cboWire.Text = "One Inch" Then
!wire = "O"
End If
!bp_type = Left(Str2Field(cboBP.Text), 2)
!cocode = cboCompany.ListIndex
!inv_type = cboInvType.ListIndex
End With
moRSProj.Update
End Sub
Private Sub lstContractor_DblClick()
txtContractor = lstContractor.List(lstContractor.ListIndex)
txtConId = lstContractor.ItemData(lstContractor.ListIndex)
lstContractor.Visible = False
' cmdFindCont.Visible = False
If Len(txtCode) = 0 Then
txtCode.SetFocus
Else
txtConSuper.SetFocus
End If
End Sub
Private Sub lstProject_Click()
If lstProject.ListIndex <> -1 Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
If FormFind() Then
Call FormShow
' Call MatLoad
' Call OptLoad
' Call OptMatLoad
End If
End If
End Sub
Private Sub FormShow()
mboolSHOW = True
gintPROJID = moRSProj!Proj_ID
With moRSProj
txtCode = Field2Str(!Proj_Code)
txtDesc = Field2Str(!Proj_Desc)
txtContractor = Field2Str(!Proj_Cont)
txtConSuper = Field2Str(!cont_sup)
txtVWPSuper = Field2Str(!vwp_sup)
txtSWAdj = Field2Str2(!sw_adj)
txtSWOrder = Format(Field2Str2(!sw_order), "##.00")
txtProjId = Field2Str(!Proj_ID)
txtConId = Field2Str(!cont_id)
txtSYN_T = Field2Str(!syn_t)
txtSYN_O = Field2Double(!syn_o)
txtSyn_O2 = Field2Double(!syn_o2)
txtBidDue = Field2Str(!biddate)
chkSYN = Field2CheckBox(!SYNTHETIC)
chkGotBid = Field2CheckBox(!gotbid)
chkComplete = Field2CheckBox(!complete)
chkFHA = Field2CheckBox(!FHA)
chkBill = Field2CheckBox(!bill)
chkOpen = Field2CheckBox(!use_open)
txtMAS90AR = Field2Str(!ar)
txtMAS90JC = Field2Str(!jccode)
txtRetention = Field2Str2(!retention)
txtInv = Field2Str(!inv)
txtDue = Field2Str(!duedate)
txtDue2 = Field2Str(!duedate2)
chk2Dates = Field2CheckBox(!twodates)
chkINACTIVE = Field2CheckBox(!inactive)
chkPulte = Field2CheckBox(!Pulte)
chkPulteSW = Field2CheckBox(!P_SW)
chkPaintInv = Field2CheckBox(!Paint2)
lblCDate = Field2Str(!Create)
lblCDate = lblCDate & " - " & Field2Str(!CUser)
lblUDate = Field2Str(!Update)
lblUDate = lblUDate & " - " & Field2Str(!UUser)
chkCertified = Field2CheckBox(!certpr)
chkBag100 = Field2CheckBox(!bag100)
chkTYPAR = Field2CheckBox(!TYPAR)
If !wire = "O" Then
cboWire.Text = "One Inch"
ElseIf !wire = "P" Then
cboWire.Text = "Paperback"
ElseIf !wire = "F" Then
cboWire.Text = "Self Furring"
End If
If !ftype = "O" Then
cboFType.Text = "One Inch"
ElseIf !ftype = "T" Then
cboFType.Text = "One Inch"
ElseIf !ftype = "D" Then
cboFType.Text = "Dow Foam"
ElseIf !ftype = "U" Then
cboFType.Text = "Urethane Foam"
End If
If !stype = "S" Then
cboStype.Text = "Superwall"
ElseIf !stype = "M" Then
cboStype.Text = "Pre-Mix Stucco"
ElseIf !stype = "T" Then
cboStype.Text = "Three Coat"
ElseIf !stype = "C" Then
cboStype.Text = "Synthetic"
ElseIf !stype = "B" Then
cboStype.Text = "Synthetic w/ 1 Kote"
ElseIf !stype = "W" Then
cboStype.Text = "Western 1 Kote"
ElseIf !stype = "N" Then
cboStype.Text = "San Man"
End If
cboCompany.ListIndex = Field2Str2(!cocode)
cboInvType.ListIndex = Field2Str2(!inv_type)
Call CBFindString3(cboBP, Field2Str(!bp_type))
End With
mboolSHOW = False
End Sub
Private Sub CheckLots()
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset
Dim strSQL As String, intResponse As Integer, strMSG As String
Dim strSELECT As String, strGET As String, intID As Integer
strSQL = "SELECT Lot_no FROM tblLotInfo where proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
strMSG = "There have been Lots processed for this Subdivision."
strMSG = strMSG & vbCrLf & "You cannot delete this Project"
intResponse = MsgBox(strMSG, vbCritical & vbOKOnly, "Delete Error")
Exit Sub
End If
oRS.Close
strSQL = "SELECT est_id FROM tblplans where proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
If oRS.RecordCount > 0 Then
strMSG = "There are Plans in the database for this subdivision"
strMSG = strMSG & vbCrLf & "Do you want to Delete These Plans Also?"
intResponse = MsgBox(strMSG, vbQuestion & vbYesNo, "Project Plans Delete Error")
If intResponse = vbYes Then
Do Until oRS.EOF
intID = oRS!est_id
strGET = "SELECT optid FROM tblPOptions where estid = " & intID
Set oRSS = New Recordset
oRSS.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
If oRSS.RecordCount > 0 Then
Do Until oRSS.EOF
strGET = "DELETE * FROM tblPOMatrl where optid = " & oRSS!OPTID
goConn.Execute strGET
oRSS.MoveNext
Loop
End If
strGET = "DELETE * FROM tblPOptions where est_id = " & intID
goConn.Execute strGET
strGET = "DELETE * FROM tblplanmat where est_id = " & intID
goConn.Execute strGET
oRS.MoveNext
Loop
oRS.Close
strGET = "DELETE * FROM tblPlans where proj_id = " & gintPROJID
goConn.Execute strGET
ElseIf intResponse = vbNo Then
oRS.Close
Exit Sub
End If
End If
strSQL = "SELECT toid FROM tbltake where proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
If oRS.RecordCount > 0 Then
strMSG = "There are Takeoffs in the database for this subdivision"
strMSG = strMSG & vbCrLf & "Do you want to Delete These Takeoffs Also?"
intResponse = MsgBox(strMSG, vbQuestion & vbYesNo, "Project Takeoff Delete Error")
If intResponse = vbYes Then
Do Until oRS.EOF
intID = oRS!toid
strGET = "DELETE * FROM tbloption WHERE toid = " & intID
goConn.Execute strGET
strGET = "DELETE * FROM tblOptMatrl where toid = " & intID
goConn.Execute strGET
strGET = "DELETE * FROM tblMeasure where toid = " & intID
goConn.Execute strGET
strGET = "DELETE * FROM tblTOMatrl where toid = " & intID
goConn.Execute strGET
oRS.MoveNext
Loop
oRS.Close
strGET = "DELETE * FROM tblTake where proj_id = " & gintPROJID
goConn.Execute strGET
ElseIf intResponse = vbNo Then
oRS.Close
Exit Sub
End If
End If
mboolDelete = True
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim strSQL As String
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If Not cmdSave.Enabled Then
cmdSave.Enabled = True
cmdAdd.Enabled = False
End If
If KeyCode = vbKeyR And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
Call cmdFindCont_Click
' gintPROJID = lstProject.ItemData(lstProject.ListIndex)
' gintLOTID = lstLots.ItemData(lstLots.ListIndex)
' frmPaySheet.Show 1
End If
Exit Sub
End If
End Sub
Private Sub lstProject_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub txtCode_GotFocus()
Call FieldSelect(txtCode)
End Sub
Private Sub txtCode_LostFocus()
txtCode = UCase(txtCode)
End Sub
Private Sub txtConSuper_GotFocus()
Call FieldSelect(txtConSuper)
End Sub
Private Sub txtConSuper_LostFocus()
txtConSuper = UCase(txtConSuper)
End Sub
Private Sub txtContractor_GotFocus()
Call FieldSelect(txtContractor)
End Sub
Private Sub txtContractor_LostFocus()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
If txtConId = "" Then
txtContractor = UCase(txtContractor)
strSQL = "SELECT cont_id, CONTRCR, AR from tblConInfo WHERE contrcr = '" & Field2Str(txtContractor) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Call ContractorLoad
lstContractor.Visible = True
Else
' txtContractor = lstContractor.List(lstContractor.ListIndex)
txtConId = Field2Str(oRS!cont_id)
txtMAS90AR = Field2Str(oRS!ar)
End If
End If
End Sub
Private Sub txtDesc_GotFocus()
Call FieldSelect(txtDesc)
End Sub
Private Sub txtDesc_LostFocus()
txtDesc = UCase(txtDesc)
End Sub
Private Sub txtInv_GotFocus()
Call FieldSelect(txtInv)
End Sub
Private Sub txtInv_LostFocus()
txtInv = UCase(txtInv)
End Sub
Private Sub txtMAS90AR_GotFocus()
Call FieldSelect(txtMAS90AR)
End Sub
Private Sub txtMAS90AR_LostFocus()
txtMAS90AR = UCase(txtMAS90AR)
End Sub
Private Sub txtMAS90JC_GotFocus()
Call FieldSelect(txtMAS90JC)
End Sub
Private Sub txtMAS90JC_LostFocus()
txtMAS90JC = UCase(txtMAS90JC)
End Sub
Private Sub txtSWAdj_GotFocus()
Call FieldSelect(txtSWAdj)
End Sub
Private Sub txtVWPSuper_GotFocus()
Call FieldSelect(txtVWPSuper)
End Sub
Private Sub txtVWPSuper_LostFocus()
txtVWPSuper = UCase(txtVWPSuper)
End Sub
Private Sub txtBidDue_GotFocus()
Call FieldSelect(txtBidDue)
End Sub
Private Sub txtBidDue_LostFocus()
If Len(txtBidDue) > 0 Then
txtBidDue = Format(txtBidDue, "00/00/####")
If Not IsDate(txtBidDue) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtBidDue.SetFocus
End If
End If
End Sub