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

1177 lines
37 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmAR
Caption = "Accounts Receivable"
ClientHeight = 6570
ClientLeft = 60
ClientTop = 345
ClientWidth = 7530
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6570
ScaleWidth = 7530
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtDueDates
Height = 1350
Left = 195
MultiLine = -1 'True
TabIndex = 19
Top = 5175
Width = 7125
End
Begin LpLib.fpList lstDetail
Height = 1425
Left = 195
TabIndex = 17
Top = 3480
Width = 5895
_Version = 196608
_ExtentX = 10398
_ExtentY = 2514
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 5
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmAR.frx":0000
End
Begin LpLib.fpList lstHeader
Height = 2835
Left = 195
TabIndex = 16
Top = 585
Width = 4470
_Version = 196608
_ExtentX = 7885
_ExtentY = 5001
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 6
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmAR.frx":0392
End
Begin VB.TextBox txtTax
Height = 315
Left = 5580
TabIndex = 15
Top = 3000
Width = 495
End
Begin Crystal.CrystalReport crAR
Left = 165
Top = 60
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "RePrint Invoice"
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 = 495
Left = 6165
TabIndex = 13
Top = 3660
Width = 1275
End
Begin VB.ComboBox cboARCode
Height = 315
Left = 2955
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 1
Top = 195
Width = 4515
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 = 495
Left = 6180
TabIndex = 12
Top = 4395
Width = 1275
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
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 = 495
Left = 6180
TabIndex = 11
Top = 2955
Width = 1275
End
Begin VB.CheckBox chkReady
Alignment = 1 'Right Justify
Caption = "Ready to Transfer to CMS:"
Height = 315
Left = 5190
TabIndex = 6
Top = 2415
Width = 2205
End
Begin VB.TextBox txtItemAmt
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 11
TabIndex = 5
Top = 1935
Width = 1200
End
Begin VB.TextBox txtSalesCode
Height = 315
Left = 6240
MaxLength = 7
TabIndex = 4
Top = 1515
Width = 1200
End
Begin VB.TextBox txtDueDate
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 10
TabIndex = 3
Top = 1095
Width = 1200
End
Begin VB.TextBox txtInvDate
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 10
TabIndex = 2
Top = 675
Width = 1200
End
Begin VB.Label lblDueDt
AutoSize = -1 'True
Caption = "Invoice Due Dates For Selected Builder"
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 = 195
TabIndex = 18
Top = 4950
Width = 3390
End
Begin VB.Label lblTax
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Tax Code"
Height = 195
Left = 4830
TabIndex = 14
Top = 3090
Width = 690
End
Begin VB.Label lblSalesCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMS Sales Code:"
Height = 195
Left = 4920
TabIndex = 10
Top = 1620
Width = 1245
End
Begin VB.Label lblItemAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Item Amount:"
Height = 195
Left = 5235
TabIndex = 9
Top = 2040
Width = 930
End
Begin VB.Label lblDueDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payment Due Date:"
Height = 195
Left = 4770
TabIndex = 8
Top = 1200
Width = 1395
End
Begin VB.Label lblInvDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Date:"
Height = 195
Left = 5190
TabIndex = 7
Top = 780
Width = 960
End
Begin VB.Label lblARCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Builder's CMS AR Code:"
Height = 195
Left = 1200
TabIndex = 0
Top = 240
Width = 1710
End
End
Attribute VB_Name = "frmAR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSDetail As Recordset
Dim moRSProj As Recordset
Dim mboolSHOW As Boolean, mboolUPDATE As Boolean, mstrType As String, mstrPO_NUM As String
Dim mstrINVNO As String, mstrPROJLOT As String, mlngTRANSID As Long, mstrINVNO2 As String
Dim mlngINVID As Long, mintBOOKMARK As Integer, mintBOOK As Integer, mboolHEADER As Boolean
Dim msglItemAmt As Single, msglInvTotal As Single, mlngTRANS2 As Long, mlngDTRANSID As Long
Private Sub HeaderLoad()
Dim oRS As Recordset
Dim strSQL As String
'Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
' strTYPE = Trim(Left(cboARCode, 7))
' strSQL = "SELECT Invoice_date, Invoice_no, lot_id, trans_id, header, shipped, customer_no, non_tax_amt from tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
' strSQL = "SELECT Invoice_date, Invoice_no, lot_id, trans_id, header, shipped, customer_no, non_tax_amt FROM tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
strSQL = "SELECT * FROM tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHeader.Clear
' strTYPE = oRS.RecordCount
Do Until oRS.EOF
With lstHeader
strLine = ""
strLine = Field2Str2(oRS!Trans_ID) & vbTab & Field2Str(oRS!invoice_no) & vbTab & Field2Str(oRS!invoice_date) & vbTab
' strLine = Field2Str2(oRS!Lot_id) & vbTab & Field2Str(oRS!invoice_no) & vbTab & Field2Str(oRS!invoice_date) & vbTab
strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "#,#.00;(#,#.00)") & vbTab & Format(Field2Str2(oRS!Lot_ID), "000000") & vbTab & (Field2Str(oRS!po_num))
' strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "#,#.00;(#,#.00)") & vbTab & Format(Field2Str2(oRS!Lot_id), "000000") & vbTab & Format(Field2Str(oRS!po_num))
' strLine = ""
' strLine = Field2Str(oRS!invoice_no) & " " & Field2Str(oRS!invoice_date) & vbTab
' strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "Currency") & " " & Format(Field2Str2(oRS!Lot_id), "000000")
.AddItem strLine
' .AddItem strLine
' .ItemData(.NewIndex) = oRS!Trans_ID
' .ItemData(.NewIndex) = oRS!Lot_ID
End With
oRS.MoveNext
Loop
oRS.Close
If lstHeader.ListCount Then
lstHeader.ListIndex = 0
Else
gintLOTID = 0
lstHeader.ListIndex = -1
cmdPrint.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module HeaderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub DetailLoad()
Dim oRS As Recordset, strSalesCode As String
Dim strSQL As String, strLine As String, strHEADER As String
On Error GoTo Error_EH
' lstHeader.col = 1
lstHeader.col = 0
mlngTRANS2 = Field2Str2(lstHeader.ColText)
' strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, description, amount from tblARInvoice WHERE shipped and lot_id = " & gintLOTID & " and not done"
strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, Delete, INVOICE_NO, description, amount, PO_NUM from tblARInvoice WHERE shipped and not done and PO_NUM = '" & mstrPO_NUM & "' and INVOICE_NO = '" & mstrINVNO2 & "'" ' and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' msglInvTotal = 0
lstDetail.Clear
Do Until oRS.EOF
strSalesCode = Field2Str(oRS!sales_code)
If Len(strSalesCode) = 0 Then
strSalesCode = "BLANK"
' Else
End If
If Field2Str(oRS!header) = True Then
strHEADER = "1"
mboolHEADER = True
ElseIf Field2Str(oRS!header) = False Then
strHEADER = "2"
mboolHEADER = False
End If
strLine = ""
' msglInvTotal = msglInvTotal + field2single(oRS!amount)
' If Len(Format(Field2Str2(oRS!amount), "currency")) > 7 Then
' strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & Field2Str(oRS!Description)
' Else
strLine = Field2Long(oRS!Trans_ID) & vbTab & Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "#,0.00") & vbTab & Field2Str(oRS!Description) & vbTab & strHEADER
' strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & Field2Str(oRS!Description) & vbTab & strHEADER
' End If
lstDetail.AddItem strLine
' lstDetail.ItemData(lstDetail.NewIndex) = Field2Long(oRS!Trans_ID)
oRS.MoveNext
Loop
oRS.Close
If lstDetail.ListCount Then
lstDetail.ListIndex = 0
Else
lstDetail.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module DetailLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub DetailLoadHOLD()
Dim oRS As Recordset, strSalesCode As String
Dim strSQL As String, strLine As String
On Error GoTo Error_EH
' lstHeader.col = 1
lstHeader.col = 0
mlngTRANS2 = Field2Str2(lstHeader.ColText)
' strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, description, amount from tblARInvoice WHERE shipped and lot_id = " & gintLOTID & " and not done"
strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, INVOICE_NO, description, amount, PO_NUM from tblARInvoice WHERE shipped and not done and PO_NUM = '" & mstrPO_NUM & "' and INVOICE_NO = '" & mstrINVNO2 & "'" ' and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' msglInvTotal = 0
lstDetail.Clear
Do Until oRS.EOF
strSalesCode = Field2Str(oRS!sales_code)
If Len(strSalesCode) = 0 Then
strSalesCode = "BLANK"
' Else
End If
strLine = ""
' msglInvTotal = msglInvTotal + field2single(oRS!amount)
If Len(Format(Field2Str2(oRS!amount), "currency")) > 7 Then
strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & Field2Str(oRS!Description)
Else
strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & vbTab & Field2Str(oRS!Description)
End If
lstDetail.AddItem strLine
lstDetail.ItemData(lstDetail.NewIndex) = Field2Long(oRS!Trans_ID)
oRS.MoveNext
Loop
oRS.Close
If lstDetail.ListCount Then
lstDetail.ListIndex = 0
Else
lstDetail.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module DetailLoadHOLD"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cboARCode_Change()
lstHeader.Clear
lstDetail.Clear
Call HeaderLoad
End Sub
Private Sub cboARCode_Click()
lstHeader.Clear
lstDetail.Clear
Call HeaderLoad
Call FormFindBuilder
End Sub
Private Sub chkReady_Click()
cmdSave.Enabled = True
End Sub
Private Sub cmdPrint_Click()
Dim oRS As Recordset, strSQL As String, strSELECT As String
Dim lngTransID As Long, strPONUM As String
On Error GoTo Error_EH
gintCOPY = 1
lstDetail.col = 0
lngTransID = Field2Str2(lstDetail.ColText)
' strSQL = "SELECT trans_id, ProjLot, PO_Num FROM tblARINVOICE WHERE trans_id = " & lstDetail.ItemData(lstDetail.ListIndex)
strSQL = "SELECT trans_id, ProjLot, PO_Num FROM tblARINVOICE WHERE trans_id = " & lngTransID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
gstrPONUM = Field2Str(oRS!po_num)
mstrPROJLOT = Field2Str(oRS!ProjLot)
Call LotChange(mstrPROJLOT, "RePrint AR Invoice")
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "' and Not {tblARInvoice.Delete}"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crAR.ReportFileName = App.Path & "\invoice.rpt"
crAR.ReplaceSelectionFormula (strSELECT)
' crAR.CopiesToPrinter = gintCOPY
crAR.CopiesToPrinter = 1
crAR.Destination = crptToWindow
' crar.Destination = crptToPrinter
crAR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintStoneInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
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 strYN As String, strSQL As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset, strUPDT As String
' D - Mark the Highlighted Item As Deleted and DONE and not READY to keep from transfering to CMS
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 = vbKeyD And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Mark an item as DELETED so it will not transfer to CMS
' If KeyCode = vbKeyD And (gbytSECURITY < 3) Then ' Delete An Option Out of the Billing Grid
If CtrlDown Then
If mboolHEADER Then
MsgBox "You Cannot Delete A Header Line", vbOKOnly, "Cannot Delete"
Exit Sub
End If
strYN = MsgBox("Are You Sure You Want To Delete This Line?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
strSQL = "SELECT * FROM tblARInvoice WHERE Trans_id = " & mlngDTRANSID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
' 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)
' strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, Delete, INVOICE_NO, description, amount, PO_NUM from tblARInvoice WHERE shipped and not done and PO_NUM = '" & mstrPO_NUM & "' and INVOICE_NO = '" & mstrINVNO2 & "'" ' and not done"
' strSELECT = "SELECT SUM(AMOUNT) as SUMAmount FROM tblARINVOICE WHERE shipped and not done and PO_NUM = '" & mstrPO_NUM & "' and INVOICE_NO = '" & mstrINVNO2 & "'"
oRS!Delete = vbTrue
oRS!ready = vbFalse
oRS!done = vbTrue
' oRS!NON_TAX_AMT = Field2Str2(oRSS!SUMAmount)
oRS.Update
strSELECT = "SELECT SUM(AMOUNT) as SUMAmount FROM tblARINVOICE WHERE shipped and not done and PO_NUM = '" & mstrPO_NUM & "' and INVOICE_NO = '" & mstrINVNO2 & "'"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
strUPDT = "UPDATE tblARINVOICE SET NON_TAX_AMT = " & Field2Str2(oRSS!SUMAmount) & " WHERE not DELETE and INVOICE_NO = '" & mstrINVNO2 & "'"
goConn.Execute strUPDT
' oRS.Update
' goConn.Execute strSQL
Call DetailLoad
' Call UpStart
' Call AddBill2
End If
End If
If Not cmdSave.Enabled Then
' Call DataHasChanged
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
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 moRSProj.State = adStateOpen Then
moRSProj.Close
End If
If moRSDetail.State = adStateOpen Then
moRSDetail.Close
End If
Exit Sub
Error_EH:
If Err.Number = 91 Then
Resume Next
End If
gstrMODULE = "Form Repair - Module Form QueryUnload"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstDetail.ListIndex
mintBOOK = lstHeader.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
Call FormSave
lstHeader.ListIndex = mintBOOK
lstDetail.Enabled = True
lstDetail.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
End Sub
Private Sub Form_Load()
Call ARCodeLoad
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, _
adOpenForwardOnly, adLockReadOnly
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ARCodeLoad()
Dim oRS As Recordset
Dim strSQL As String, intRows As Integer, strLine As String
Dim row, col As Long
On Error GoTo Error_EH
strSQL = "SELECT Bill_Id, Cust_no, Name FROM tblARMaster"
' strSQL = "SELECT Bill_Id, Cust_no, Name FROM tblARMaster"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
strLine = Field2Str(oRS!Cust_NO) & " - " & Field2Str(oRS!Name)
cboARCode.AddItem strLine
cboARCode.ItemData(cboARCode.NewIndex) = Field2Long(oRS!Bill_ID)
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module ARCodeLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
With moRSDetail
txtInvDate = Field2Str(!invoice_date)
txtDueDate = Field2Str(!inv_due_date)
txtItemAmt = Format(Field2Str2(!amount), "#,#.00;(#,#.00)")
' txtItemAmt = Format(Field2Str2(!amount), "Standard")
txtSalesCode = Field2Str(!sales_code)
If Len(txtSalesCode) = 0 Then
txtSalesCode = "BLANK"
txtSalesCode.BackColor = &H80FFFF
txtSalesCode.ForeColor = &HFF&
Else
txtSalesCode.BackColor = &H80000005
txtSalesCode.ForeColor = &H80000008
txtSalesCode.FontBold = False
End If
txtTax = Field2Str(!taxcode)
If txtTax = "AZ" Then
txtTax.BackColor = &H80FFFF
txtTax.ForeColor = &HFF&
txtTax.FontBold = True
ElseIf txtTax = "" Then
txtTax.BackColor = &H80FFFF
txtTax.ForeColor = &HFF&
txtTax.FontBold = True
Else
txtTax.BackColor = &H80000005
txtTax.ForeColor = &H80000008
txtTax.FontBold = False
End If
chkReady = Field2CheckBox(!ready)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindDetail() As Boolean
Dim strSQL As String, lngDETAIL As Long
On Error GoTo Error_EH
lstDetail.col = 0
lngDETAIL = Field2Str2(lstDetail.ColText)
mlngDTRANSID = lngDETAIL
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblARInvoice "
strSQL = strSQL & "WHERE trans_id = " & lngDETAIL
' strSQL = strSQL & "WHERE trans_id = " & lstDetail.ItemData(lstDetail.ListIndex)
Set moRSDetail = New Recordset
moRSDetail.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSDetail.EOF Then
FormFindDetail = False
Else
FormFindDetail = True
msglInvTotal = moRSDetail!non_tax_amt
mstrType = moRSDetail!inv_type
gintPROJID = moRSDetail!PROJ_ID
Call ProjLoad
End If
Exit Function
Error_EH:
gstrMODULE = "Form AR - Module FormFindDetail"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindBuilder() As Boolean
Dim strSQL As String, lngBUILDER As Long
Dim oRSB As Recordset
On Error GoTo Error_EH
lngBUILDER = cboARCode.ItemData(cboARCode.ListIndex)
strSQL = "SELECT * FROM tblARMaster WHERE bill_id = " & lngBUILDER
Set oRSB = New Recordset
oRSB.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRSB.EOF Then
FormFindBuilder = False
txtDueDates = ""
Else
FormFindBuilder = True
txtDueDates = Field2Str(oRSB!DueDate)
End If
Exit Function
Error_EH:
gstrMODULE = "Form AR - Module FormFindBuilder"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub lstDetail_Click()
If lstDetail.ListIndex <> -1 Then
If FormFindDetail() Then
Call FormShow
End If
End If
End Sub
Private Sub FieldsSave()
Dim strSQL As String, lngTransID As Long
Dim oRS As Recordset, sglTOTAL As Single
On Error GoTo Error_EH
With moRSDetail
!invoice_date = Str2Field(txtInvDate)
!inv_due_date = Str2Field(txtDueDate)
!price = Str2Field(txtItemAmt)
!amount = Str2Field(txtItemAmt)
!sales_code = Str2Field(txtSalesCode)
!taxcode = Str2Field(txtTax) '*************This may need to be turned off
.Update
End With
strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE PO_NUM = '" & mstrPO_NUM & "' and lot_id = " & gintLOTID & " and not done"
' strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE Trans_ID = " & mlngTRANSID & " and lot_id = " & gintLOTID & " and not done"
' strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID & " and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
msglInvTotal = Field2Str2(oRS!sglTOTAL)
strSQL = "SELECT * FROM tblARInvoice WHERE PO_NUM = '" & mstrPO_NUM & "' and lot_id = " & gintLOTID
' strSQL = "SELECT * FROM tblARInvoice WHERE Trans_ID = " & mlngTRANSID & " and lot_id = " & gintLOTID
' strSQL = "SELECT * FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRS.EOF
With oRS
!invoice_date = Str2Field(txtInvDate)
!inv_due_date = Str2Field(txtDueDate)
!ready = chkReady
!non_tax_amt = msglInvTotal
!taxcode = Str2Field(txtTax) '*****DOES THIS NEED TO BE TURNED BACK ON??????
If Field2Str2(moRSProj!retention) > 0 Then
!retention_amt = Format(((msglInvTotal * Field2Str2(moRSProj!retention) / 100)), "#.00")
Else
!retention_amt = 0
End If
.Update
End With
oRS.MoveNext
Loop
Call HeaderLoad
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
' If lstHeader.ListCount = 0 Then
' intResponse = MsgBox("No Invoices For This Builder - Select A Different Builder.", vbExclamation + vbOKOnly, "Exit Form")
' Unload Me
' End If
End Sub
Private Sub FormClear()
txtInvDate = ""
txtDueDate = ""
txtSalesCode = ""
txtItemAmt = ""
chkReady = vbUnchecked
End Sub
Private Sub lstDetail_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub lstHeader_Click()
On Error GoTo Error_EH
If lstHeader.ListIndex <> -1 Then
lstHeader.col = 0
mlngTRANSID = Field2Str2(lstHeader.ColText)
lstHeader.col = 1
mstrINVNO2 = Field2Str2(lstHeader.ColText) '********** TEST THIS
cmdPrint.Enabled = True
lstHeader.col = 4
gintLOTID = lstHeader.ColText
lstHeader.col = 5
mstrPO_NUM = Field2Str(lstHeader.ColText)
' gintLOTID = lstHeader.ItemData(lstHeader.ListIndex)
Call DetailLoad
If lstDetail.ListIndex <> -1 Then
Else
lstDetail.Clear
Call FormClear
End If
Else
cmdPrint.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module lstHeader_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstHeader_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub txtDueDate_GotFocus()
Call FieldSelect(txtDueDate)
End Sub
Private Sub txtDueDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtDueDate, "/", 1)
If lngPOS = 0 Then
If Len(txtDueDate) > 0 Then
txtDueDate = Format(txtDueDate, "00/00/####")
If Not IsDate(txtDueDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtDueDate.SetFocus
End If
End If
ElseIf IsDate(txtDueDate) Then
Exit Sub
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtDueDate.SetFocus
End If
End Sub
Private Sub txtInvDate_GotFocus()
Call FieldSelect(txtInvDate)
End Sub
Private Sub txtInvDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtInvDate, "/", 1)
If lngPOS = 0 Then
If Len(txtInvDate) > 0 Then
txtInvDate = Format(txtInvDate, "00/00/####")
If Not IsDate(txtInvDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtInvDate.SetFocus
End If
End If
ElseIf IsDate(txtInvDate) Then
Exit Sub
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtInvDate.SetFocus
End If
End Sub
Private Sub txtItemAmt_GotFocus()
Call FieldSelect(txtItemAmt)
msglItemAmt = Single2Field(txtItemAmt)
End Sub
Private Sub txtItemAmt_LostFocus()
If msglItemAmt < Field2Str2(txtItemAmt) Then
msglInvTotal = msglInvTotal + Field2Str2(txtItemAmt)
txtItemAmt = Format(txtItemAmt, "#,#.00")
ElseIf msglItemAmt > Field2Str2(txtItemAmt) Then
msglInvTotal = msglInvTotal - Field2Str2(txtItemAmt)
txtItemAmt = Format(txtItemAmt, "#,#.00")
ElseIf msglItemAmt = Field2Str(txtItemAmt) Then
txtItemAmt = Format(txtItemAmt, "#,#.00")
End If
End Sub
Private Sub txtSalesCode_GotFocus()
Call FieldSelect(txtSalesCode)
End Sub
Private Sub txtSalesCode_LostFocus()
txtSalesCode = UCase(txtSalesCode)
End Sub
Private Sub txtTax_GotFocus()
Call FieldSelect(txtTax)
End Sub
Private Sub txtTax_LostFocus()
If Not IsNull(txtTax) Or txtTax = "" Then
txtTax = UCase(txtTax)
Else
MsgBox "You Must Enter A Sales Tax Code", vbOKOnly, "No Tax Code"
txtTax.SetFocus
End If
End Sub
Reference in New Issue View Git Blame Copy Permalink