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

1109 lines
31 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Begin VB.Form frmProject2
Caption = "Project Information"
ClientHeight = 6495
ClientLeft = 60
ClientTop = 345
ClientWidth = 12120
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6495
ScaleWidth = 12120
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtDue
Height = 315
Left = 6600
TabIndex = 19
Top = 4800
Width = 555
End
Begin VB.TextBox txtInv
Height = 315
Left = 9360
MaxLength = 2
TabIndex = 21
Top = 480
Width = 555
End
Begin VB.TextBox txtRetention
Alignment = 1 'Right Justify
Height = 315
Left = 7200
MaxLength = 2
TabIndex = 20
Top = 480
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 = 13
Top = 3000
Width = 975
End
Begin VB.CheckBox chkOpen
Caption = "Use 50% Openings"
Height = 255
Left = 9960
TabIndex = 24
Top = 120
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 = 12
Top = 2640
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 = 11
Top = 2640
Width = 975
End
Begin VB.CheckBox chkBill
Caption = "Bill Lath && Stucco Combined"
Height = 255
Left = 7560
TabIndex = 23
Top = 120
Value = 1 'Checked
Width = 2355
End
Begin VB.TextBox txtMAS90JC
Height = 315
Left = 5040
MaxLength = 4
TabIndex = 18
Top = 4800
Width = 1080
End
Begin VB.TextBox txtMAS90AR
Height = 315
Left = 5040
MaxLength = 7
TabIndex = 17
Top = 4440
Width = 1080
End
Begin VB.TextBox txtSWOrder
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 = 6180
TabIndex = 10
Top = 2280
Width = 975
End
Begin VB.CheckBox chkFHA
Caption = "FHA Metal"
Height = 255
Left = 6480
TabIndex = 22
Top = 120
Width = 1155
End
Begin VB.CheckBox chkComplete
Caption = "Project Completed"
Height = 255
Left = 4800
TabIndex = 39
TabStop = 0 'False
Top = 120
Width = 1695
End
Begin VB.CheckBox chkGotBid
Caption = "Got Bid"
Height = 255
Left = 3900
TabIndex = 38
TabStop = 0 'False
Top = 120
Width = 855
End
Begin VB.TextBox txtProjId
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 = 315
Left = 10740
TabIndex = 37
Top = 480
Width = 975
End
Begin VB.TextBox txtConId
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 = 315
Left = 10740
TabIndex = 36
Top = 840
Width = 975
End
Begin VB.ListBox lstContractor
Height = 4740
Left = 7800
Sorted = -1 'True
TabIndex = 35
TabStop = 0 'False
Top = 1620
Visible = 0 'False
Width = 4215
End
Begin VB.ComboBox cboStype
Height = 315
ItemData = "frmProject2.frx":0000
Left = 5040
List = "frmProject2.frx":0019
Style = 2 'Dropdown List
TabIndex = 16
Top = 4080
Width = 1935
End
Begin VB.ComboBox cboFType
Height = 315
ItemData = "frmProject2.frx":0079
Left = 5040
List = "frmProject2.frx":0086
Style = 2 'Dropdown List
TabIndex = 15
Top = 3720
Width = 1935
End
Begin VB.ComboBox cboBP
Height = 315
ItemData = "frmProject2.frx":00AD
Left = 5040
List = "frmProject2.frx":00AF
Style = 2 'Dropdown List
TabIndex = 14
Top = 3360
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 = 9
Top = 2280
Width = 975
End
Begin VB.TextBox txtVWPSuper
Height = 315
Left = 5040
MaxLength = 15
TabIndex = 8
Top = 1920
Width = 2655
End
Begin VB.TextBox txtConSuper
Height = 315
Left = 5040
MaxLength = 15
TabIndex = 7
Top = 1560
Width = 2655
End
Begin VB.TextBox txtContractor
Height = 315
Left = 5040
MaxLength = 30
TabIndex = 6
Top = 1200
Width = 5115
End
Begin VB.TextBox txtDesc
Height = 315
Left = 5040
MaxLength = 30
TabIndex = 5
Top = 840
Width = 5115
End
Begin VB.TextBox txtCode
Height = 315
Left = 5040
MaxLength = 6
TabIndex = 4
Top = 480
Width = 975
End
Begin VB.ListBox lstProject
Height = 6300
Left = 300
Sorted = -1 'True
TabIndex = 1
Top = 60
Width = 3255
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 555
Left = 3600
TabIndex = 3
TabStop = 0 'False
Top = 5880
Width = 1395
End
Begin VB.CommandButton cmdAdd
Caption = "Add"
Height = 555
Left = 5040
TabIndex = 2
TabStop = 0 'False
Top = 5220
Width = 1395
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
Enabled = 0 'False
Height = 555
Left = 5040
TabIndex = 0
TabStop = 0 'False
Top = 5880
Width = 1395
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 555
Left = 3600
TabIndex = 25
Top = 5220
Width = 1395
End
Begin VB.Label lblDue
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Day of Month Due:"
Height = 195
Left = 6240
TabIndex = 46
Top = 4500
Width = 1350
End
Begin VB.Label lblInv
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Code:"
Height = 195
Left = 8280
TabIndex = 45
Top = 540
Width = 990
End
Begin VB.Label lblRetention
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Retention %:"
Height = 195
Left = 6240
TabIndex = 44
Top = 540
Width = 900
End
Begin VB.Label lblSynOpen2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Synthetic Adjust PopOuts:"
Height = 195
Left = 4260
TabIndex = 43
Top = 3060
Width = 1845
End
Begin VB.Label lblSynAdj
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Syn. Adjust T/O:"
Height = 195
Left = 3780
TabIndex = 42
Top = 2700
Width = 1185
End
Begin VB.Label lblMAS90JC
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Job Cost Code:"
Height = 195
Left = 3885
TabIndex = 41
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 = 40
Top = 4500
Width = 1260
End
Begin VB.Label lblStuccoType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Type:"
Height = 195
Left = 4005
TabIndex = 34
Top = 4140
Width = 960
End
Begin VB.Label lblFoamType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Foam Type:"
Height = 195
Left = 4125
TabIndex = 33
Top = 3780
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 = 3420
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 = 2340
Width = 1335
End
Begin VB.Label lblVWPSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP Super:"
Height = 195
Left = 4080
TabIndex = 30
Top = 1980
Width = 885
End
Begin VB.Label lblConSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor Super:"
Height = 195
Left = 3720
TabIndex = 29
Top = 1620
Width = 1245
End
Begin VB.Label lblContractor
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor:"
Height = 195
Left = 4185
TabIndex = 28
Top = 1260
Width = 780
End
Begin VB.Label lblCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Project Code:"
Height = 195
Left = 4005
TabIndex = 27
Top = 540
Width = 960
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Name:"
Height = 195
Left = 4500
TabIndex = 26
Top = 900
Width = 465
End
End
Attribute VB_Name = "frmProject2"
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 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 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
strSQL = "SELECT Proj_id, Proj_code, Proj_Desc from tblProject"
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
Else
intBookmark = lstProject.ListIndex
End If
Call FieldsSave
moRSProj.Update
If mboolAdding Then
mboolAdding = False
intBookmark = 0
End If
Call ProjectLoad
lstProject.ListIndex = intBookmark
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"
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
txtProjId = ""
txtConId = ""
txtRetention = 0
txtMAS90AR = ""
txtMAS90JC = ""
txtInv = ""
txtDue = 1
chkGotBid = vbUnchecked
chkComplete = vbUnchecked
chkFHA = vbUnchecked
chkBill = vbChecked
chkOpen = vbChecked
cboBP.ListIndex = -1
cboStype.ListIndex = -1
cboFType.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 = Integer2Field(txtSWOrder)
!gotbid = chkGotBid
!complete = chkComplete
!FHA = chkFHA
!ar = Str2Field(txtMAS90AR)
!jccode = Str2Field(txtMAS90JC)
!bill = chkBill
!syn_t = Integer2Field(txtSYN_T)
!syn_o = Integer2Field(txtSYN_O)
!syn_o2 = Integer2Field(txtSyn_O2)
!use_open = chkOpen
!ftype = Field2Str(Left(cboFType.Text, 1))
!retention = Integer2Field(txtRetention)
!inv = Str2Field(txtInv)
!duedate = Integer2Field(txtDue)
!UUser = gstrLOGIN
!Update = Date
If cboStype.Text = "Superwall" Then
!stype = "S"
ElseIf cboStype.Text = "Magna Wall" 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
!bp_type = Left(Str2Field(cboBP.Text), 2)
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 = Field2Str2(!sw_order)
txtProjId = Field2Str(!proj_id)
txtConId = Field2Str(!cont_id)
txtSYN_T = Field2Str(!syn_t)
txtSYN_O = Field2Str(!syn_o)
txtSyn_O2 = Field2Str(!syn_o2)
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)
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 = "Magna Wall"
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
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)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSave.Enabled Then
cmdSave.Enabled = True
cmdAdd.Enabled = False
End If
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
Reference in New Issue View Git Blame Copy Permalink