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_Inv/frmContractor.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

1000 lines
28 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Begin VB.Form frmContractor
Caption = "Contractor Information"
ClientHeight = 5070
ClientLeft = 60
ClientTop = 345
ClientWidth = 10845
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5070
ScaleWidth = 10845
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkShowAll
Caption = "Show All Contractors"
Height = 495
Left = 9345
TabIndex = 40
Top = 3585
Width = 1455
End
Begin VB.CheckBox chkINACTIVE
Caption = "InActive Contractor"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 7305
TabIndex = 39
Top = 3690
Width = 2055
End
Begin VB.TextBox txtBillPhone
Alignment = 1 'Right Justify
Height = 315
Left = 8880
TabIndex = 17
Top = 4080
Width = 1875
End
Begin VB.TextBox txtBillContact
Height = 315
Left = 6180
TabIndex = 16
Top = 4080
Width = 2715
End
Begin VB.TextBox txtPager
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
MaxLength = 10
TabIndex = 14
Top = 3360
Width = 1635
End
Begin VB.TextBox txtFAX
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
MaxLength = 10
TabIndex = 12
Top = 2640
Width = 1635
End
Begin VB.TextBox txtPhone
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
MaxLength = 10
TabIndex = 11
Top = 2280
Width = 1635
End
Begin VB.TextBox txtZip
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 = 9480
TabIndex = 10
Top = 1920
Width = 975
End
Begin VB.TextBox txtMAS90AR
Height = 315
Left = 6180
MaxLength = 7
TabIndex = 15
Top = 3720
Width = 1080
End
Begin VB.TextBox txtCell
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
MaxLength = 10
TabIndex = 13
Top = 3000
Width = 1635
End
Begin VB.TextBox txtState
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 = 8940
TabIndex = 9
Top = 1920
Width = 495
End
Begin VB.TextBox txtCity
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 = 8
Top = 1920
Width = 2715
End
Begin VB.TextBox txtAddress2
Height = 315
Left = 6180
MaxLength = 30
TabIndex = 7
Top = 1560
Width = 4575
End
Begin VB.TextBox txtConSuper
Height = 315
Left = 6180
MaxLength = 20
TabIndex = 5
Top = 840
Width = 2715
End
Begin VB.TextBox txtAddress1
Height = 315
Left = 6180
MaxLength = 30
TabIndex = 6
Top = 1200
Width = 4575
End
Begin VB.TextBox txtName
Height = 315
Left = 6180
MaxLength = 30
TabIndex = 4
Top = 480
Width = 4575
End
Begin VB.ListBox lstContractor
Height = 4935
Left = 300
Sorted = -1 'True
TabIndex = 1
Top = 60
Width = 4275
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 = 555
Left = 9180
TabIndex = 3
TabStop = 0 'False
Top = 4440
Width = 1395
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 = 555
Left = 4680
TabIndex = 2
TabStop = 0 'False
Top = 4440
Width = 1395
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
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 = 555
Left = 7680
TabIndex = 0
TabStop = 0 'False
Top = 4440
Width = 1395
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 = 555
Left = 6180
TabIndex = 18
Top = 4440
Width = 1395
End
Begin VB.Label lblBilling
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Billing Contact/Ph:"
Height = 195
Left = 4785
TabIndex = 38
Top = 4140
Width = 1320
End
Begin VB.Label lblLast
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8640
TabIndex = 37
Top = 120
Width = 2115
End
Begin VB.Label lblPCount
BorderStyle = 1 'Fixed Single
Height = 315
Left = 7920
TabIndex = 36
Top = 120
Width = 675
End
Begin VB.Label lblProject
AutoSize = -1 'True
Caption = "Project Count:"
Height = 195
Left = 6900
TabIndex = 35
Top = 180
Width = 1005
End
Begin VB.Label lblUDate
BorderStyle = 1 'Fixed Single
Height = 315
Left = 7980
TabIndex = 34
Top = 3240
Width = 2775
End
Begin VB.Label lblCDate
BorderStyle = 1 'Fixed Single
Height = 315
Left = 7980
TabIndex = 33
Top = 2580
Width = 2775
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 = 7980
TabIndex = 32
Top = 3000
Width = 1215
End
Begin VB.Label lblCreated
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 = 7980
TabIndex = 31
Top = 2340
Width = 735
End
Begin VB.Label lblConId
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6180
TabIndex = 30
Top = 120
Width = 675
End
Begin VB.Label lblPager
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pager:"
Height = 195
Left = 5640
TabIndex = 29
Top = 3420
Width = 465
End
Begin VB.Label lblFax
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "FAX #:"
Height = 195
Left = 5610
TabIndex = 28
Top = 2700
Width = 495
End
Begin VB.Label lblPhone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Telephone:"
Height = 195
Left = 5295
TabIndex = 27
Top = 2340
Width = 810
End
Begin VB.Label lblMAS90AR
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "MAS90 AR Code:"
Height = 195
Left = 4845
TabIndex = 26
Top = 3780
Width = 1260
End
Begin VB.Label lblCell
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Cell #:"
Height = 195
Left = 5655
TabIndex = 25
Top = 3060
Width = 450
End
Begin VB.Label lblCSZ
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "City/State/Zip:"
Height = 195
Left = 5055
TabIndex = 24
Top = 1980
Width = 1050
End
Begin VB.Label lblAdd2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Address 2:"
Height = 195
Left = 5355
TabIndex = 23
Top = 1620
Width = 750
End
Begin VB.Label lblConSuper
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Purchasing Contact:"
Height = 195
Left = 4665
TabIndex = 22
Top = 900
Width = 1440
End
Begin VB.Label lblAdd1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Address 1:"
Height = 195
Left = 5355
TabIndex = 21
Top = 1260
Width = 750
End
Begin VB.Label lblCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor #:"
Height = 195
Left = 5175
TabIndex = 20
Top = 180
Width = 930
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Contractor Name:"
Height = 195
Left = 4860
TabIndex = 19
Top = 540
Width = 1245
End
End
Attribute VB_Name = "frmContractor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSCont As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Dim mboolDelete As Boolean
Dim mintCONTID As Integer
Private Sub chkShowAll_Click()
Call ContractorLoad
End Sub
Private Sub cmdAdd_Click()
cmdAdd.Enabled = False
' cmdDelete.Enabled = False
cmdExit.Enabled = False
' cmdFindCont.Visible = True
mboolAdding = True
lstContractor.Enabled = False
Call FormClear
End Sub
Private Sub cmdDelete_Click()
mboolDelete = False
Call CheckLots
If mboolDelete = True Then
moRSCont.Delete
End If
Call ContractorLoad
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
lstContractor.Enabled = True
' cmdDelete.Enabled = True
cmdSave.Enabled = False
cmdAdd.Enabled = True
cmdExit.Enabled = True
Call FormSave
lstContractor.SetFocus
End Sub
Private Sub Form_Load()
Dim lngContId As Long
Call ContractorLoad
If Not gbytSECURITY > 3 Then
' cmdDelete.Enabled = True
End If
If gintPAYID > 0 Then 'See if this form was called from the project notes form
lngContId = CLng(gintPAYID)
Call ListFindItem(lstContractor, lngContId)
End If
End Sub
Private Sub ContractorLoad()
Dim oRS As Recordset, lngBOOKMARK As Long
Dim strSQL As String
Dim strLine As String
lngBOOKMARK = 0
If chkShowAll Then
strSQL = "SELECT Cont_id, contrcr from tblConInfo"
Else
strSQL = "SELECT Cont_id, contrcr from tblConInfo WHERE NOT INACTIVE"
End If
' strSQL = "SELECT Cont_id, contrcr from tblConInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngBOOKMARK = lstContractor.ListIndex
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.ListIndex = lngBOOKMARK
Else
lstContractor.ListIndex = 0
End If
End Sub
Private Sub FormSave()
Dim intBookmark As Integer
On Error GoTo Error_EH
If mboolAdding Then
moRSCont.AddNew
moRSCont!C_USER = gstrLOGIN
Else
intBookmark = lstContractor.ListIndex
End If
Call FieldsSave
moRSCont.Update
If mboolAdding Then
mboolAdding = False
intBookmark = 0
End If
Call ContractorLoad
lstContractor.ListIndex = intBookmark
Exit Sub
Error_EH:
Call ErrorHandler(moRSCont.ActiveConnection)
Exit Sub
End Sub
Private Sub FormClear()
txtName = ""
txtConSuper = ""
txtAddress1 = ""
txtAddress2 = ""
txtCity = ""
txtState = ""
txtZip = ""
txtPhone = ""
txtFAX = ""
txtCell = ""
txtPager = ""
lblConId = ""
txtMAS90AR = ""
txtBillContact = ""
txtBillPhone = ""
chkINACTIVE = vbUnchecked
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblConInfo "
strSQL = strSQL & "WHERE Cont_id = " & mintCONTID
Set moRSCont = New Recordset
If moRSCont.State = adStateOpen Then
moRSCont.Close
End If
moRSCont.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSCont.EOF Then
FormFind = False
Else
FormFind = True
End If
End Function
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSCont
!contrcr = Str2Field(txtName)
!contact = Str2Field(txtConSuper)
!add1 = Str2Field(txtAddress1)
!add2 = Str2Field(txtAddress2)
!city = Str2Field(txtCity)
!State = Str2Field(txtState)
!zip = Str2Field(txtZip)
!phone = Str2Field(txtPhone)
!fax = Str2Field(txtFAX)
!cell = Str2Field(txtCell)
!pager = Str2Field(txtPager)
!ar = Str2Field(txtMAS90AR)
!billing = Str2Field(txtBillContact)
!bill_ph = Str2Field(txtBillPhone)
!inactive = Field2CheckBox(chkINACTIVE)
!Update = Now()
!U_USER = gstrLOGIN
End With
moRSCont.Update
Exit Sub
Error_EH:
gstrMODULE = " Form Contractor - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstContractor_Click()
If lstContractor.ListIndex <> -1 Then
mintCONTID = lstContractor.ItemData(lstContractor.ListIndex)
If FormFind() Then
Call FormShow
' Call MatLoad
' Call OptLoad
' Call OptMatLoad
End If
End If
End Sub
Private Sub FormShow()
Dim oRS As Recordset, strSQL As String, intPCount As Integer
mboolSHOW = True
mintCONTID = moRSCont!cont_id
strSQL = "SELECT Proj_id, Cont_id, Create FROM tblProject WHERE cont_id = " & mintCONTID & " ORDER BY Create DESC"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
intPCount = oRS.RecordCount
With moRSCont
txtName = Field2Str(!contrcr)
txtConSuper = Field2Str(!contact)
txtAddress1 = Field2Str(!add1)
txtAddress2 = Field2Str(!add2)
txtCity = Field2Str(!city)
txtState = Field2Str(!State)
txtZip = Field2Str(!zip)
txtPhone = Field2Str(!phone)
txtFAX = Field2Str(!fax)
txtCell = Field2Str(!cell)
txtPager = Field2Str(!pager)
lblConId = Field2Str2(!cont_id)
txtMAS90AR = Field2Str(!ar)
txtBillContact = Field2Str(!billing)
txtBillPhone = Field2Str2(!bill_ph)
lblCDate = Field2Str(!Create)
lblCDate = lblCDate & " - " & Field2Str(!C_USER)
lblUDate = Field2Str(!Update)
lblUDate = lblUDate & " - " & Field2Str(!U_USER)
lblPCount = intPCount
chkINACTIVE = Field2CheckBox(!inactive)
If intPCount > 0 Then
lblLast = oRS!Create
End If
End With
mboolSHOW = False
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 lstContractor_DblClick()
cmdSave.Enabled = True
cmdAdd.Enabled = False
End Sub
Private Sub txtBillContact_GotFocus()
Call FieldSelect(txtBillContact)
End Sub
Private Sub txtBillContact_LostFocus()
txtBillContact = UCase(txtBillContact)
End Sub
Private Sub txtBillPhone_GotFocus()
Call FieldSelect(txtBillPhone)
End Sub
Private Sub txtConSuper_GotFocus()
Call FieldSelect(txtConSuper)
End Sub
Private Sub txtConSuper_LostFocus()
txtConSuper = UCase(txtConSuper)
End Sub
Private Sub txtName_GotFocus()
Call FieldSelect(txtName)
End Sub
Private Sub txtName_LostFocus()
txtName = UCase(txtName)
End Sub
Private Sub txtAddress1_GotFocus()
Call FieldSelect(txtAddress1)
End Sub
Private Sub txtAddress1_LostFocus()
txtAddress1 = UCase(txtAddress1)
End Sub
Private Sub txtAddress2_GotFocus()
Call FieldSelect(txtAddress2)
End Sub
Private Sub txtAddress2_LostFocus()
txtAddress2 = UCase(txtAddress2)
End Sub
Private Sub txtMAS90AR_GotFocus()
Call FieldSelect(txtMAS90AR)
End Sub
Private Sub txtMAS90AR_LostFocus()
txtMAS90AR = UCase(txtMAS90AR)
End Sub
Private Sub txtCity_GotFocus()
Call FieldSelect(txtCity)
End Sub
Private Sub txtCity_LostFocus()
txtCity = UCase(txtCity)
End Sub
Private Sub txtState_GotFocus()
Call FieldSelect(txtState)
End Sub
Private Sub txtState_LostFocus()
txtState = UCase(txtState)
End Sub
Private Sub txtCell_GotFocus()
Call FieldSelect(txtCell)
End Sub
Private Sub txtCell_LostFocus()
txtCell = UCase(txtCell)
End Sub
Private Sub txtzip_GotFocus()
Call FieldSelect(txtZip)
End Sub
Private Sub txtPager_GotFocus()
Call FieldSelect(txtPager)
End Sub
Private Sub txtPager_LostFocus()
txtPager = UCase(txtPager)
End Sub
Private Sub txtFAX_GotFocus()
Call FieldSelect(txtFAX)
End Sub
Private Sub txtFAX_LostFocus()
txtFAX = UCase(txtFAX)
End Sub
Private Sub txtPhone_GotFocus()
Call FieldSelect(txtPhone)
End Sub
Private Sub txtPhone_LostFocus()
' If Len(txtPhone) > 0 Then
' txtPhone = Format(txtPhone, "### ### ####")
' End If
End Sub
Private Sub CheckLots()
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset
Dim oRSC As Recordset, strSql2 As String
Dim strSQL As String, intResponse As Integer, strMSG As String
Dim strSELECT As String, strGET As String, intID As Integer
strSql2 = "SELECT Proj_id, Cont_id, Proj_desc FROM tblProject WHERE cont_id = " & mintCONTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockReadOnly
Do Until oRSC.EOF
gintPROJID = oRSC!proj_id
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 - " & oRSC!proj_desc
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 - " & oRSC!proj_desc
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
oRSC.MoveNext
Loop
mboolDelete = True
End Sub
Reference in New Issue View Git Blame Copy Permalink