azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a67be0f3f258577aa24ab56e69d1ca9cceff25d7
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmBilling.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

1533 lines
45 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Begin VB.Form frmBilling
Caption = "Project Billing Information"
ClientHeight = 4380
ClientLeft = 60
ClientTop = 345
ClientWidth = 12045
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4380
ScaleWidth = 12045
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtOWDlrs
Height = 315
Left = 10590
TabIndex = 50
Top = 1620
Visible = 0 'False
Width = 765
End
Begin VB.TextBox txtOWPctg
Height = 315
Left = 10590
TabIndex = 49
Top = 1290
Width = 765
End
Begin VB.CheckBox chkOWrap
Caption = "Wrap Ins."
Height = 225
Left = 8580
TabIndex = 46
Top = 1260
Width = 1305
End
Begin VB.TextBox txtWrapDlrs
Height = 315
Left = 2040
TabIndex = 45
Top = 4080
Visible = 0 'False
Width = 765
End
Begin VB.TextBox txtWrapPctg
Height = 315
Left = 2040
TabIndex = 42
Top = 3780
Width = 765
End
Begin VB.CheckBox chkWrap
Caption = "Wrap Insurance"
Height = 270
Left = 1395
TabIndex = 41
Top = 3540
Width = 1500
End
Begin VB.TextBox txtPNTFCode
Height = 315
Left = 3300
TabIndex = 12
Top = 3195
Width = 1035
End
Begin VB.TextBox txtPNTFBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
TabIndex = 13
Top = 3195
Width = 1035
End
Begin VB.CommandButton cmdUpDesc
Caption = "Update Option Desc"
Height = 540
Left = 4410
TabIndex = 39
Top = 3570
Width = 1035
End
Begin VB.TextBox txtPNTEBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
TabIndex = 11
Top = 2850
Width = 1035
End
Begin VB.TextBox txtPNTECode
Height = 315
Left = 3300
TabIndex = 10
Top = 2850
Width = 1035
End
Begin VB.TextBox txtPNTBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
TabIndex = 9
Top = 2505
Width = 1035
End
Begin VB.TextBox txtPNTCode
Height = 315
Left = 3300
TabIndex = 8
Top = 2505
Width = 1035
End
Begin VB.CommandButton cmdUp
Caption = "Command1"
Height = 495
Left = 4245
TabIndex = 33
Top = 810
Visible = 0 'False
Width = 855
End
Begin VB.CommandButton cmdAddDate
Caption = "New Effective 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 = 555
Left = 8580
TabIndex = 32
Top = 1545
Width = 1335
End
Begin VB.ComboBox cboEffDate
Height = 315
Left = 3240
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 30
Top = 420
Width = 1635
End
Begin VB.TextBox txtSTCode
Height = 315
Left = 3300
MaxLength = 6
TabIndex = 6
Top = 2160
Width = 1035
End
Begin VB.TextBox txtSTBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
MaxLength = 10
TabIndex = 7
Top = 2160
Width = 1035
End
Begin VB.CheckBox chkOption
Alignment = 1 'Right Justify
Caption = "Bill Options with Stucco:"
Height = 255
Left = 1620
TabIndex = 28
Top = 840
Width = 2055
End
Begin VB.TextBox txtOCode
Height = 315
Left = 9840
MaxLength = 6
TabIndex = 21
Top = 900
Width = 1035
End
Begin VB.TextBox txtSCode
Height = 315
Left = 3300
MaxLength = 6
TabIndex = 4
Top = 1800
Width = 1035
End
Begin VB.TextBox txtLCode
Height = 315
Left = 3300
MaxLength = 6
TabIndex = 2
Top = 1440
Width = 1035
End
Begin VB.CommandButton cmdPrint
Caption = "Print Price List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 8580
TabIndex = 26
TabStop = 0 'False
Top = 3345
Width = 1335
End
Begin VB.CommandButton cmdSaveOpt
Caption = "Save &Option Information"
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 = 555
Left = 8580
TabIndex = 23
Top = 2760
Width = 1335
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 8580
TabIndex = 24
TabStop = 0 'False
Top = 3915
Width = 1335
End
Begin VB.CommandButton cmdSave
Caption = "&Save Plan Information"
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 = 555
Left = 8580
TabIndex = 14
Top = 2160
Width = 1335
End
Begin VB.TextBox txtOptBill
Alignment = 1 'Right Justify
Height = 315
Left = 10920
MaxLength = 10
TabIndex = 22
Top = 900
Width = 1035
End
Begin VB.CheckBox chkBill
Alignment = 1 'Right Justify
Caption = "Bill Lath && Stucco Combined:"
Height = 255
Left = 1320
TabIndex = 1
Top = 1140
Width = 2355
End
Begin VB.TextBox txtSBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
MaxLength = 10
TabIndex = 5
Top = 1800
Width = 1035
End
Begin VB.TextBox txtLBill
Alignment = 1 'Right Justify
Height = 315
Left = 4380
MaxLength = 10
TabIndex = 3
Top = 1440
Width = 1035
End
Begin VB.ListBox lstOptions
Height = 3375
Left = 5505
Sorted = -1 'True
TabIndex = 15
Top = 885
Width = 2895
End
Begin VB.ListBox lstMod_Elv
Height = 3180
Left = 60
Sorted = -1 'True
TabIndex = 0
Top = 870
Width = 1155
End
Begin Crystal.CrystalReport crRepair
Left = 7920
Top = 420
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.Label lblOWDlrs
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Wrap $: "
Height = 195
Left = 9990
TabIndex = 48
Top = 1680
Visible = 0 'False
Width = 615
End
Begin VB.Label lblOWPctg
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Wrap %: "
Height = 195
Left = 9915
TabIndex = 47
Top = 1350
Width = 645
End
Begin VB.Label lblWrapDlrs
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Wrap $: "
Height = 195
Left = 1440
TabIndex = 44
Top = 4140
Visible = 0 'False
Width = 615
End
Begin VB.Label lblWrapPctg
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Wrap %: "
Height = 195
Left = 1410
TabIndex = 43
Top = 3840
Width = 645
End
Begin VB.Label lblPaintFinal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Paint Billing Final Code/Amt:"
Height = 195
Left = 1305
TabIndex = 40
Top = 3270
Width = 1995
End
Begin VB.Label lblPaintEBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Paint Billing Ext Code/Amt:"
Height = 195
Left = 1410
TabIndex = 38
Top = 2940
Width = 1890
End
Begin VB.Label lblPaintBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Paint Billing Int Code/Amt:"
Height = 195
Left = 1455
TabIndex = 37
Top = 2565
Width = 1845
End
Begin VB.Label lblPOption
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 540
Left = 9960
TabIndex = 36
Top = 2775
Width = 2100
WordWrap = -1 'True
End
Begin VB.Label lblOptUsed
Caption = "OPTION USED"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 9990
TabIndex = 35
Top = 2190
Visible = 0 'False
Width = 1440
End
Begin VB.Label lblOptOrder
Height = 240
Left = 9960
TabIndex = 34
Top = 2430
Width = 2040
End
Begin VB.Label lblEffDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Price Effective Date:"
Height = 195
Left = 1665
TabIndex = 31
Top = 480
Width = 1470
End
Begin VB.Label lblStoneBill
Alignment = 1 'Right Justify
Caption = "Stone Billing Code/Amt:"
Height = 195
Left = 1545
TabIndex = 29
Top = 2205
Width = 1755
End
Begin VB.Label lblDesc
BorderStyle = 1 'Fixed Single
Height = 375
Left = 8400
TabIndex = 27
Top = 420
Width = 3435
End
Begin VB.Label txtProject
Alignment = 2 'Center
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 = 375
Left = 60
TabIndex = 25
Top = 0
Width = 11775
End
Begin VB.Label lblOptAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Option Code/Amt:"
Height = 195
Left = 8520
TabIndex = 20
Top = 960
Width = 1275
End
Begin VB.Label lblStuccoBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Billing Code/Amt:"
Height = 195
Left = 1530
TabIndex = 19
Top = 1845
Width = 1770
End
Begin VB.Label lblLathBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Billing Code/Amt:"
Height = 195
Left = 1725
TabIndex = 18
Top = 1485
Width = 1575
End
Begin VB.Label lblOptions
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Options:"
Height = 195
Left = 5580
TabIndex = 17
Top = 660
Width = 585
End
Begin VB.Label lblPlans
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Plans:"
Height = 195
Left = 120
TabIndex = 16
Top = 660
Width = 435
End
End
Attribute VB_Name = "frmBilling"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRS As Recordset
Dim moRSOpt As Recordset
Dim moRSProj As Recordset
Dim mboolSHOW As Boolean, mboolOPTUSED As Boolean
Dim mboolAdding As Boolean
Dim mboolCopy As Boolean, mintBOOKMARK As Integer
Dim mstrType As String, mstrMODEL As String
Dim mintESTID As Integer, mintPROJID As Integer, mintESTID2 As Integer
Dim mintOPTID As Integer, mintLOTID As Integer
Dim mstrSQL As String
Dim mstrNewDate As String, mstrCopyDate As String
Private Sub cboEffDate_Change()
Call ListLoad
End Sub
Private Sub cboEffDate_Click()
Call ListLoad
End Sub
Private Sub cmdAddDate_Click()
Dim strNewDate As String, strCopyDate As String, intYN As Integer
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset, lngPOS As Long
strNewDate = InputBox("Enter the New Effective Date for this Tract (MMDDYYYY)", "New Date", Date)
' If Not IsDate(strNewDate) Then
' MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date"
' Exit Sub
' End If
lngPOS = InStr(1, strNewDate, "/", 1)
If Not IsDate(strNewDate) Then
If lngPOS = 0 Then
If Len(strNewDate) > 0 Then
strNewDate = Format(strNewDate, "00/00/####")
If Not IsDate(strNewDate) Then
MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date"
' Call cmdExit_Click
' mboolBAD = True
Exit Sub
End If
' mstrSTARTDATE = strNewDate
Else
MsgBox "The Date You Entered is not Valid Now Exiting", vbOKOnly, "InValid Date"
' mboolBAD = True
Exit Sub
' Call cmdExit_Click
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - Exiting"
' Call cmdExit_Click
' mboolBAD = True
Exit Sub
End If
' Else
' mstrSTARTDATE = strNewDate
End If
cboEffDate.AddItem strNewDate
mstrNewDate = strNewDate
strSQL = "Select * FROM tblProjDate"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS.AddNew
oRS!Proj_ID = gintPROJID
oRS!startdate = strNewDate
oRS.Update
End If
intYN = MsgBox("Do You Want To Copy Plans from A Previous Effective Date?", vbQuestion + vbYesNo, "Copy?")
If intYN = vbYes Then
strCopyDate = InputBox("What is the Old Effective Date to Use?", "Old Date", cboEffDate.Text)
If Not IsDate(strCopyDate) Then
MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date"
Exit Sub
End If
mstrCopyDate = strCopyDate
strSQL = "SELECT * FROM tblPlanBill WHERE Proj_id = " & gintPROJID & " and effdate = #" & strCopyDate & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
strSql2 = "SELECT * FROM tblPlanBill"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.AddNew
oRSS!Proj_ID = gintPROJID
oRSS!est_id = oRS!est_id
mintESTID = oRS!est_id
oRSS!Mod_Elv = oRS!Mod_Elv
oRSS!l_bill = 0
oRSS!s_bill = 0
oRSS!Create = Date
oRSS!createuser = gstrLOGIN
oRSS!notes = oRS!notes
oRSS!l_code = oRS!l_code
oRSS!s_code = oRS!s_code
oRSS!st_bill = oRS!st_bill
oRSS!st_code = oRS!st_code
oRSS!effdate = strNewDate
oRSS!pnt_bill = oRS!pnt_bill
oRSS!pnt_ebill = oRS!pnt_ebill
oRSS!pnt_fbill = oRS!pnt_fbill
oRSS!pnt_fcode = oRS!pnt_fcode
oRSS!pnt_ecode = oRS!pnt_ecode
oRSS!PNT_CODE = oRS!PNT_CODE
oRSS!Wrap = oRS!Wrap
oRSS!WPctg = oRS!WPctg
oRSS.Update
Call CopyOption
oRS.MoveNext
Loop
Else
End If
End Sub
Private Sub CopyOption()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
strSQL = "SELECT * FROM tblPOptBill WHERE est_id = " & mintESTID & " and effdate = #" & mstrCopyDate & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
strSql2 = "SELECT * FROM tblPOptBill"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.AddNew
oRSS!est_id = mintESTID
oRSS!OPTID = oRS!OPTID
oRSS!opt_no = oRS!opt_no
oRSS!Desc = oRS!Desc
oRSS!b_code = oRS!b_code
oRSS!created = Date
oRSS!C_USER = gstrLOGIN
oRSS!Amt = 0
oRSS!Wrap = oRS!Wrap
oRSS!WPctg = oRS!WPctg
oRSS!effdate = mstrNewDate
oRSS.Update
oRS.MoveNext
Loop
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String
Dim strDate As String
On Error GoTo Error_EH
strDate = cboEffDate.Text
strMONTH = Format(Mid(strDate, 1, 2), "00")
strDAY = Format(Mid(strDate, 4, 2), "00")
strYEAR = Format(Mid(strDate, 7, 4), "0000")
gintPRINT = 1
frmReport.Show 1
' strSQL = "{tblPlans.Proj_id} = " & gintPROJID 'date(" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'"
strSQL = "{tblPlanBill.Proj_id} = " & gintPROJID & " and {tblPlanBill.EffDate} = date(" & strYEAR & "," & strMONTH & "," & strDAY & ")" ' and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'"
crREPAIR.ReportFileName = App.Path & "\PriceList.rpt"
crREPAIR.SelectionFormula = strSQL
' crRepair.Destination = crptToWindow
crREPAIR.CopiesToPrinter = gintCOPY
crREPAIR.Destination = gintDEST
crREPAIR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSaveOpt_Click()
Dim strSQL As String
On Error GoTo Error_EH
' *********************************This does not save correctly - it creates a duplicate key - need to check this
moRSOpt!est_id = gintESTID
moRSOpt!Amt = Double2Field(txtOptBill)
' moRSOpt!billcode = Str2Field(txtOBillCode)
' moRSOpt!costcode = Str2Field(txtOCostCode)
moRSOpt!effdate = Field2Str(cboEffDate.Text)
moRSOpt!b_code = Str2Field(txtOCode)
moRSOpt!Wrap = Field2CheckBox(chkWrap)
moRSOpt!WPctg = Double2Field(txtOWPctg)
' moRSOpt!WDlrs = Double2Field(txtOWDlrs)
moRSOpt.Update
cmdSaveOpt.Enabled = False
' txtContract.Enabled = True
txtLBill.Enabled = True
txtSBill.Enabled = True
txtLCode.Enabled = True
txtSCode.Enabled = True
' txtBillCode.Enabled = True
lstMod_Elv.Enabled = True
lstOptions.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module cmdSaveOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdUp_Click()
Dim strSQL As String, oRS As Recordset
Dim strSql2 As String, oRSS As Recordset
' strSQL = "Select * from tblplanbill" ' where effdate = null"
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' Do Until oRS.EOF
' If IsDate(oRS!effdate) Then
' Else
' oRS!effdate = "01/01/2005"
' oRS.Update
' End If
' oRS.MoveNext
' Loop
strSQL = "SELECT * FROM tblPlanBill"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
strSql2 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Str(oRS!est_id)
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
Do Until oRSS.EOF
oRSS!effdate = oRS!effdate
oRSS.Update
oRSS.MoveNext
Loop
End If
oRS.MoveNext
Loop
MsgBox "Update is Done"
End Sub
Private Sub cmdUpDesc_Click()
Dim strSQL As String, strDESC As String, strOPTID As String
Dim strSQLL As String, strYN As String, intCNT As Integer
Dim oRS As Recordset, oRSS As Recordset
intCNT = 0
lstOptions.ListIndex = intCNT
strSQLL = "SELECT est_id, optid, desc, effdate FROM tblPOptBill WHERE est_id = " & gintESTID & " and effdate = #" & cboEffDate.Text & "#"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
Do Until oRSS.EOF
lstOptions.ListIndex = intCNT
strOPTID = Field2Str2(oRSS!OPTID)
' strOPTID = lstOptions.ItemData
strSQL = "SELECT optid, Desc FROM tblPOPTION WHERE optid = " & CLng(strOPTID)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRSS!Desc = Field2Str(oRS!Desc)
oRSS.Update
Else
' strYN = MsgBox("Are You Sure You Want To Delete this Option?", vbCritical + vbYesNo, "Delete?")
' If strYN = vbNo Then
' Exit Sub
' End If
' strSQL = "SELECT * FROM tblLOption WHERE opt_id = " & gintOPTID
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' If Not oRS.EOF Then
' MsgBox "This Option Has Been Used With A Lot - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE"
' Exit Sub
' End If
' strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & oRSS!optid 'lstLOptions.ItemData(lstLOptions.ListIndex)
' goConn.Execute strSQL
' Call OptLoad
' call ""
End If
intCNT = intCNT + 1
oRSS.MoveNext
Loop
MsgBox "Option Descriptions Have Been Updated", vbOKOnly, "Done"
Call OptLoad
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 oRS As Recordset, strSQL As String, strYN As String
Dim strOptDesc As String, intBookmark As Integer
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
' If KeyCode = vbKeyA And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Show The Description From tblPOption
If KeyCode = vbKeyA And (gbytSECURITY < 3) Then ' Show The Description From tblPOption
If CtrlDown Then
strSQL = "SELECT * FROM tblPOption WHERE OPTID = " & gintOPTID & " AND EST_ID = " & Field2Str2(moRS!est_id)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
lblPOption.Visible = True
lblPOption = Field2Str(oRS!Desc)
strOptDesc = Field2Str(moRSOpt!Desc)
If Trim(strOptDesc) <> lblPOption Then
strYN = MsgBox("Do You Want To Change The Description?", vbYesNo, "Change Description?")
If strYN = vbYes Then
moRSOpt!Desc = lblPOption
moRSOpt.Update
Call OptLoad
End If
End If
Exit Sub
Else
lblPOption.Visible = True
lblPOption = "Not A Valid Option For This Plan"
End If
' strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex)
' goConn.Execute strSQL
' Call OptLoad
End If
End If
If KeyCode = vbKeyD And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid
' If KeyCode = vbKeyD And (gbytSECURITY < 3) Then ' Delete An Option Out of the Billing Grid
If CtrlDown Then
strYN = MsgBox("Are You Sure You Want To Delete this Option?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
strSQL = "SELECT * FROM tblLOption WHERE opt_id = " & gintOPTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
MsgBox "This Option Has Been Used With A Lot - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE"
Exit Sub
End If
strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex)
goConn.Execute strSQL
Call OptLoad
' Call UpStart
' Call AddBill2
End If
End If
If KeyCode = vbKeyW And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid
If CtrlDown Then
intBookmark = lstMod_Elv.ListIndex
moRS!Wrap = moRSProj!Wrap
moRS!WPctg = moRSProj!WPctg
moRS.Update
Call ListLoad
lstMod_Elv.ListIndex = intBookmark
End If
End If
If KeyCode = vbKeyO And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid
If CtrlDown Then
intBookmark = lstOptions.ListIndex
moRSOpt!Wrap = moRSProj!Wrap
moRSOpt!WPctg = moRSProj!WPctg
moRSOpt.Update
Call OptLoad
lstOptions.ListIndex = intBookmark
End If
End If
' If Not cmdSave.Enabled Then
' Call DataHasChanged
' End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSave.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
If moRS.State = adStateOpen Then
moRS.Close
End If
If moRSOpt.State = adStateOpen Then
moRSOpt.Close
End If
If moRSProj.State = adStateOpen Then
moRSProj.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstMod_Elv.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
Call FormSave
lstMod_Elv.Enabled = True
lstMod_Elv.ListIndex = mintBOOKMARK
lstOptions.Enabled = True
txtOptBill.Enabled = True
txtOCode.Enabled = True
' txtOBillCode.Enabled = True
' txtOCostCode.Enabled = True
mintBOOKMARK = 0
lstMod_Elv.SetFocus
End Sub
Private Sub Form_Load()
Set moRS = New Recordset
Set moRSOpt = New Recordset
Set moRSProj = New Recordset
Call ProjLoad
Call DateLoad
If cboEffDate.ListCount > 0 Then
Call ListLoad
End If
' Call OptLoad
End Sub
Private Sub DateLoad()
Dim oRS As Recordset, strSQL As String
strSQL = "SELECT * FROM tblPROJDATE where Proj_ID = " & gintPROJID & " Order By STARTDATE Desc"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
cboEffDate.Clear
Do Until oRS.EOF
cboEffDate.AddItem Format(Field2Str(oRS!startdate), "MM/DD/YYYY")
oRS.MoveNext
Loop
If cboEffDate.ListCount > 0 Then
cboEffDate.ListIndex = 0
End If
End Sub
Private Sub ProjLoad()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID
Set moRSProj = New Recordset
moRSProj.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSProj.EOF Then
MsgBox "No Project Information Found - Select a Different Project", vbOKOnly, "InValid Project"
Unload Me
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ListLoad()
Dim oRS As Recordset, intYN As Integer
Dim strSQL As String, strProj As String, intResponse As Integer
On Error GoTo Error_EH
' strSQL = "SELECT EST_ID, Mod_Elv, effdate from tblPLANbill WHERE Proj_ID = " & gintPROJID & " and effdate = #" & Field2Str(cboEffDate.Text) & "#"
strSQL = "SELECT EST_ID, Mod_Elv from tblPLANbill WHERE Proj_ID = " & gintPROJID & " and effdate = #" & Field2Str(cboEffDate.Text) & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstMod_Elv.Clear
Do Until oRS.EOF
With lstMod_Elv
.AddItem Field2Str(oRS!Mod_Elv)
.ItemData(.NewIndex) = oRS("est_id")
End With
oRS.MoveNext
Loop
oRS.Close
If lstMod_Elv.ListCount Then
lstMod_Elv.ListIndex = 0
Else
Call FormClear
lstOptions.Clear
Call OptClear
gstrFLAG = "D"
Beep
intResponse = MsgBox("No Plan Information for the Selected Date", vbOKOnly + vbQuestion, "No Plans")
intYN = MsgBox("Do You Want To Delete This Date?", vbYesNo, "Delete Date")
If intYN = vbYes Then
strSQL = "DELETE * FROM tblProjDate WHERE proj_id = " & gintPROJID & " and StartDate = #" & cboEffDate.Text & "#"
goConn.Execute strSQL
Call DateLoad
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module ListLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
gintESTID = moRS!est_id
txtProject = Trim$(Field2Str(moRSProj!Proj_ID)) & " " & Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc
chkBill = Field2CheckBox(moRSProj!bill)
chkOption = Field2CheckBox(moRSProj!opt)
With moRS
txtLBill = Format(Field2Str2(!l_bill), "#0.00")
txtSBill = Format(Field2Str2(!s_bill), "#0.00")
txtSTBill = Format(Field2Str2(!st_bill), "#0.00")
txtPNTBill = Format(Field2Str2(!pnt_bill), "#0.00")
txtPNTEBill = Format(Field2Str2(!pnt_ebill), "#0.00")
txtPNTFBill = Format(Field2Str2(!pnt_fbill), "#0.00")
txtPNTFCode = Field2Str(!pnt_fcode)
txtPNTECode = Field2Str(!pnt_ecode)
txtPNTCode = Field2Str(!PNT_CODE)
txtLCode = Field2Str(!l_code)
txtSCode = Field2Str(!s_code)
txtSTCode = Field2Str(!st_code)
chkWrap = Field2CheckBox(!Wrap)
txtWrapPctg = Format(Field2Str2(!WPctg), "#0.00##")
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowOpt()
On Error GoTo Error_EH
mboolSHOW = True
gintOPTID = moRSOpt!OPTID
With moRSOpt
txtOptBill = Format(Field2Str2(!Amt), "#0.00")
txtOWPctg = Format(Field2Str2(!WPctg), "#0.00##")
chkOWrap = Field2CheckBox(!Wrap)
' txtOBillCode = Field2Str2(!billcode)
' txtOCostCode = Field2Str2(!costcode)
txtOCode = Field2Str(!b_code)
lblOptOrder = "Option Number " & Trim(Field2Str(gintOPTID))
If mboolOPTUSED Then
lblOptUsed.Visible = True
ElseIf mboolOPTUSED = False Then
lblOptUsed.Visible = False
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module FormShowOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OptClear()
txtOptBill = ""
txtOCode = ""
' txtOBillCode = ""
' txtOCostCode = ""
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
moRS.Update
moRSProj!bill = chkBill
moRSProj!opt = chkOption
moRSProj.Update
Call ListLoad
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, intResponse As Integer
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPlanBill "
strSQL = strSQL & "WHERE est_ID = " & lstMod_Elv.ItemData(lstMod_Elv.ListIndex) & " and effdate = #" & Field2Str(cboEffDate.Text) & "#"
Set moRS = New Recordset
moRS.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRS.EOF Then
intResponse = MsgBox("No Plan Information for The Selected Date?", vbOKOnly + vbQuestion, "No Plans")
lstMod_Elv.Enabled = False
FormFind = False
Call FormClear
Call OptClear
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Billing - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindOpt() As Boolean
Dim strSQL As String
Dim strSQLL As String, oRSO As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOptBill "
strSQL = strSQL & "WHERE OPTID = " & lstOptions.ItemData(lstOptions.ListIndex)
strSQL = strSQL & " and EffDate = #" & cboEffDate.Text & "#"
Set moRSOpt = New Recordset
moRSOpt.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSOpt.EOF Then
FormFindOpt = False
Else
strSQLL = "SELECT * FROM tblLOPTION WHERE OPT_ID = " & lstOptions.ItemData(lstOptions.ListIndex)
Set oRSO = New Recordset
oRSO.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSO.EOF Then
mboolOPTUSED = True
Else
mboolOPTUSED = False
End If
FormFindOpt = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Billing - Module FormFindOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub lstMod_Elv_Click()
If lstMod_Elv.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
Call OptLoad
End If
End If
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRS
!l_bill = Double2Field(txtLBill)
!s_bill = Double2Field(txtSBill)
!st_bill = Double2Field(txtSTBill)
!pnt_bill = Double2Field(txtPNTBill)
!pnt_ebill = Double2Field(txtPNTEBill)
!pnt_fbill = Double2Field(txtPNTFBill)
!pnt_fcode = Str2Field(txtPNTFCode)
!pnt_ecode = Str2Field(txtPNTECode)
!PNT_CODE = Str2Field(txtPNTCode)
!l_code = Str2Field(txtLCode)
!s_code = Str2Field(txtSCode)
!st_code = Str2Field(txtSTCode)
!Wrap = Field2CheckBox(chkWrap)
!WPctg = Double2Field(txtWrapPctg)
' !WDlrs = Double2Field(txtWrapDlrs)
!BUpdate = Date
!BUUser = gstrLOGIN
End With
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
If lstMod_Elv.ListCount = 0 Then
intResponse = MsgBox("No Plan Information, Exit and Import From Takeoff?", vbOKOnly + vbQuestion, "No Plans")
Unload Me
Exit Sub
End If
End Sub
Private Sub FormClear()
txtLBill = ""
txtSBill = ""
txtSTBill = ""
txtPNTBill = ""
txtPNTCode = ""
txtOptBill = ""
txtOCode = ""
txtLCode = ""
txtSCode = ""
txtSTCode = ""
txtPNTECode = ""
txtPNTEBill = ""
txtPNTFCode = ""
txtPNTFBill = ""
txtPNTCode = ""
txtPNTBill = ""
End Sub
Private Sub OptLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Est_ID, OPTID, Desc, effdate from tblPOptBill WHERE EST_ID = " & gintESTID & " and effdate = #" & cboEffDate.Text & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstOptions.Clear
Do Until oRS.EOF
With lstOptions
strLine = Field2Str(oRS!Desc)
.AddItem strLine
.ItemData(.NewIndex) = oRS!OPTID
End With
oRS.MoveNext
Loop
oRS.Close
If lstOptions.ListCount Then
lstOptions.ListIndex = 0
' lstOptions.Sorted
Else
txtOCode = ""
' txtOCostCode = ""
txtOptBill = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module OptLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstMod_Elv_DblClick()
cmdSave.Enabled = True
lstOptions.Enabled = False
txtOptBill.Enabled = False
' txtOBillCode.Enabled = False
' txtOCostCode.Enabled = False
txtOCode.Enabled = False
txtLCode.SetFocus
End Sub
Private Sub lstOptions_Click()
On Error GoTo Error_EH
lblPOption = ""
' lblPOption.Visible = False
If lstOptions.ListIndex <> -1 Then
If FormFindOpt() Then
Call FormShowOpt
Else
lstOptions.Clear
txtOptBill = "0"
' txtOBillCode = ""
' txtOCostCode = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Billing - Module lstOptions_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstOptions_DblClick()
cmdSaveOpt.Enabled = True
' txtContract.Enabled = False
txtLCode.Enabled = False
txtSCode.Enabled = False
txtLBill.Enabled = False
txtSBill.Enabled = False
' txtBillCode.Enabled = False
lstMod_Elv.Enabled = False
txtOCode.SetFocus
End Sub
Private Sub txtLBill_GotFocus()
Call FieldSelect(txtLBill)
End Sub
Private Sub txtLCode_GotFocus()
Call FieldSelect(txtLCode)
End Sub
Private Sub txtLCode_LostFocus()
txtLCode = UCase(txtLCode)
End Sub
Private Sub txtOCode_GotFocus()
Call FieldSelect(txtOCode)
End Sub
Private Sub txtOCode_LostFocus()
txtOCode = UCase(txtOCode)
End Sub
Private Sub txtOptBill_GotFocus()
Call FieldSelect(txtOptBill)
End Sub
Private Sub txtOWPctg_GotFocus()
Call FieldSelect(txtOWPctg)
End Sub
Private Sub txtOWPctg_LostFocus()
txtOWPctg = Format(Field2Str2(txtOWPctg), "#0.00##")
End Sub
Private Sub txtPNTBill_GotFocus()
Call FieldSelect(txtPNTBill)
End Sub
Private Sub txtPNTCode_GotFocus()
Call FieldSelect(txtPNTCode)
End Sub
Private Sub txtPNTEBill_GotFocus()
Call FieldSelect(txtPNTEBill)
End Sub
Private Sub txtPNTECode_GotFocus()
Call FieldSelect(txtPNTECode)
End Sub
Private Sub txtPNTFBill_GotFocus()
Call FieldSelect(txtPNTFBill)
End Sub
Private Sub txtPNTFCode_GotFocus()
Call FieldSelect(txtPNTFCode)
End Sub
Private Sub txtSBill_GotFocus()
Call FieldSelect(txtSBill)
End Sub
Private Sub txtSCode_GotFocus()
Call FieldSelect(txtSCode)
End Sub
Private Sub txtSCode_LostFocus()
txtSCode = UCase(txtSCode)
End Sub
Private Sub txtPNTCode_LostFocus()
txtPNTCode = UCase(txtPNTCode)
End Sub
Private Sub txtPNTECode_LostFocus()
txtPNTECode = UCase(txtPNTECode)
End Sub
Private Sub txtPNTFCode_LostFocus()
txtPNTFCode = UCase(txtPNTFCode)
End Sub
Private Sub txtSTBill_GotFocus()
Call FieldSelect(txtSTBill)
End Sub
Private Sub txtSTCode_GotFocus()
Call FieldSelect(txtSTCode)
End Sub
Private Sub txtSTCode_LostFocus()
txtSTCode = UCase(txtSTCode)
End Sub
Private Sub txtWrapPctg_GotFocus()
Call FieldSelect(txtWrapPctg)
End Sub
Private Sub txtWrapPctg_LostFocus()
'Dim dblWDlrs As Double, dblWPctg As Double, dblBilling As Double
txtWrapPctg = Format(Field2Str2(txtWrapPctg), "#0.00##")
' dblWPctg = Field2Str(txtWrapPctg) / 100
' dblBilling = ""
End Sub
Reference in New Issue View Git Blame Copy Permalink