Files
Mike Swanson 5359e7c49e feat(valleywide): recover VWP Orders VB6 source from D: backup drive
Recovered Darv's VB6 source for the Valley Wide Plastering Orders
application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used).
This is the first time we've had the actual source — prior session only
had a single frmPayroll.frm from the AD server.

Three project variants identified across two snapshots:
- Full-Project/   (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\
- Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\
- Source/         (170 files, 559 MB)   — D:\Office-Estimates\Darv\Source\ wholesale
- SOURCE-HOLD/    (3 files, 1 MB)       — D:\Office-Estimates\Darv\SOURCE HOLD\

Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production
Orders_10A.exe was live as of April 2024 — open question whether newer
source exists on other backup drives Mike will scan next.

Also includes per-category and per-keyword analysis CSVs from a WizTree
file-list export, plus the analyzer script that produced them
(re-runnable for the next drive's CSV).

VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live
VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:36:27 -07:00

2038 lines
60 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Begin VB.Form frmOrders
Caption = "Orders Information"
ClientHeight = 8385
ClientLeft = 60
ClientTop = 345
ClientWidth = 11415
ControlBox = 0 'False
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 8385
ScaleWidth = 11415
StartUpPosition = 2 'CenterScreen
Visible = 0 'False
Begin VB.TextBox txtOrdCnt
Height = 300
Left = 11025
TabIndex = 53
Top = 510
Visible = 0 'False
Width = 405
End
Begin VB.CheckBox chkCalc
Caption = "Check1"
Enabled = 0 'False
Height = 285
Left = 11220
TabIndex = 52
Top = 240
Width = 210
End
Begin VB.TextBox txtInvDate
Alignment = 1 'Right Justify
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 = 3360
TabIndex = 48
TabStop = 0 'False
Top = 5400
Width = 2115
End
Begin VB.CommandButton cmdMisc
Caption = "Add Misc Item"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9900
TabIndex = 47
Top = 1380
Width = 1455
End
Begin VB.TextBox txtNotes
Height = 1995
Left = 6360
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 45
TabStop = 0 'False
Top = 6300
Width = 5055
End
Begin VB.CommandButton cmdFindPO
Caption = "PO"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 2820
Picture = "frmOrders.frx":0000
Style = 1 'Graphical
TabIndex = 44
TabStop = 0 'False
Top = 6240
Visible = 0 'False
Width = 795
End
Begin Crystal.CrystalReport crOrder
Left = 10200
Top = 180
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdAR
Caption = "Setup S&W AR Transfer"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 8400
TabIndex = 42
TabStop = 0 'False
Top = 5160
Width = 1455
End
Begin VB.CommandButton cmdPrint
Caption = "&Print Invoice"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 6900
TabIndex = 41
TabStop = 0 'False
Top = 5160
Width = 1455
End
Begin VB.TextBox txtVendorInv
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4020
MaxLength = 10
TabIndex = 40
TabStop = 0 'False
Top = 7080
Width = 1755
End
Begin VB.CommandButton cmdAP
Caption = "Setup A&P Transfer"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9900
TabIndex = 38
TabStop = 0 'False
Top = 5160
Width = 1455
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9900
TabIndex = 37
TabStop = 0 'False
Top = 4380
Width = 1455
End
Begin VB.CommandButton cmdUpdate
Caption = "&Update Total"
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 = 735
Left = 6900
TabIndex = 36
TabStop = 0 'False
Top = 4380
Width = 1455
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 = 735
Left = 8400
TabIndex = 8
Top = 4380
Width = 1455
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 7
Top = 2160
Width = 2175
End
Begin VB.TextBox txtAQty
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 6
Top = 1740
Width = 1035
End
Begin VB.ListBox lstMaterials
Height = 3375
Left = 2100
TabIndex = 10
Top = 720
Width = 4155
End
Begin VB.ListBox lstOrders
Height = 3375
Left = 60
TabIndex = 3
TabStop = 0 'False
Top = 720
Width = 1995
End
Begin VB.Label lblHelp
AutoSize = -1 'True
Caption = "U/W"
Height = 195
Left = 11040
TabIndex = 51
Top = 30
Width = 360
End
Begin VB.Label lblJobCost
BorderStyle = 1 'Fixed Single
Height = 375
Left = 3735
TabIndex = 50
Top = 6240
Width = 1050
End
Begin VB.Label lblInvDate
AutoSize = -1 'True
Caption = "Inv. Date:"
Height = 195
Left = 5520
TabIndex = 49
Top = 5520
Width = 705
End
Begin VB.Label lblNotes
AutoSize = -1 'True
Caption = "Notes:"
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 = 6420
TabIndex = 46
Top = 6060
Width = 570
End
Begin VB.Line Line2
BorderWidth = 2
X1 = 6360
X2 = 11400
Y1 = 6000
Y2 = 6000
End
Begin VB.Label lblLocked
Caption = "This Invoice Has Been Transfered To AP And Is Now Locked"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1155
Left = 120
TabIndex = 43
Top = 4140
Visible = 0 'False
Width = 6075
End
Begin VB.Label lblVendorInv
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Vendor Invoice #:"
Height = 195
Left = 2640
TabIndex = 39
Top = 7155
Width = 1275
End
Begin VB.Label lblD_Update
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 = 6780
TabIndex = 35
Top = 3900
Width = 4575
End
Begin VB.Label lblD_Create
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 = 6780
TabIndex = 34
Top = 3240
Width = 4575
End
Begin VB.Label lblD_Flag
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 7500
TabIndex = 33
Top = 2580
Width = 3855
End
Begin VB.Label lblD_OQty
Alignment = 1 'Right Justify
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 = 7500
TabIndex = 32
Top = 1320
Width = 1035
End
Begin VB.Label lblUpdate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Updated:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6780
TabIndex = 31
Top = 3660
Width = 975
End
Begin VB.Label lblCreate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Created:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6780
TabIndex = 30
Top = 3000
Width = 900
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Price:"
Height = 195
Left = 6930
TabIndex = 29
Top = 2340
Width = 405
End
Begin VB.Label lblAQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Actual Qty:"
Height = 195
Left = 6555
TabIndex = 28
Top = 1800
Width = 780
End
Begin VB.Label lblOQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Original Qty:"
Height = 195
Left = 6480
TabIndex = 27
Top = 1320
Width = 855
End
Begin VB.Label lblD_Desc
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 = 7500
TabIndex = 26
Top = 900
Width = 3855
End
Begin VB.Label lblD_InvNo
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 = 7500
TabIndex = 25
Top = 480
Width = 2625
End
Begin VB.Label lblInv_No
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory:"
Height = 195
Left = 6630
TabIndex = 24
Top = 600
Width = 705
End
Begin VB.Label lblD_Type
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 = 1200
TabIndex = 23
Top = 7920
Width = 3555
End
Begin VB.Label lblD_Supplier
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 = 1200
TabIndex = 22
Top = 7500
Width = 4575
End
Begin VB.Label lblD_Percent
Alignment = 1 'Right Justify
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 = 1200
TabIndex = 21
Top = 7080
Width = 1035
End
Begin VB.Label lblD_Amount
Alignment = 1 'Right Justify
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 = 1200
TabIndex = 20
Top = 6660
Width = 1545
End
Begin VB.Label lblD_SPO
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 = 1200
TabIndex = 19
Top = 6240
Width = 1545
End
Begin VB.Label lblD_PO
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 = 1200
TabIndex = 18
Top = 5820
Width = 3555
End
Begin VB.Label lblD_ODate
Alignment = 1 'Right Justify
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 = 1200
TabIndex = 17
Top = 5400
Width = 2115
End
Begin VB.Label lblSPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Special PO #:"
Height = 195
Left = 120
TabIndex = 16
Top = 6345
Width = 990
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Type:"
Height = 195
Left = 270
TabIndex = 15
Top = 7980
Width = 840
End
Begin VB.Label lblSupplier
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Supplier:"
Height = 195
Left = 495
TabIndex = 14
Top = 7575
Width = 615
End
Begin VB.Label lblPercent
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Percentage:"
Height = 195
Left = 240
TabIndex = 13
Top = 7155
Width = 870
End
Begin VB.Label lblAmount
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Amount:"
Height = 195
Left = 90
TabIndex = 12
Top = 6750
Width = 1020
End
Begin VB.Label lblPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO Number:"
Height = 195
Left = 240
TabIndex = 11
Top = 5925
Width = 870
End
Begin VB.Label lblO_Date
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Date:"
Height = 195
Left = 285
TabIndex = 9
Top = 5520
Width = 825
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 6360
X2 = 6360
Y1 = 0
Y2 = 6000
End
Begin VB.Label lblTotal
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 5
Top = 60
Width = 1695
End
Begin VB.Label lblInvTotal
AutoSize = -1 'True
Caption = "PO Total:"
Height = 195
Left = 6720
TabIndex = 4
Top = 120
Width = 675
End
Begin VB.Label lblMatList
AutoSize = -1 'True
Caption = "Materials"
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 = 2160
TabIndex = 2
Top = 480
Width = 780
End
Begin VB.Label lblPOList
AutoSize = -1 'True
Caption = "PO Number"
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 = 120
TabIndex = 1
Top = 480
Width = 975
End
Begin VB.Label lblProjLot
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 0
Top = 60
Width = 6195
End
End
Attribute VB_Name = "frmOrders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSORDER As Recordset
Dim moRSOrdMat As Recordset
Dim moRSProj As Recordset
Dim moRS As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean, mstrPROJLOT As String
Dim mboolCopy As Boolean, mintBOOKMARK As Integer, mintBOOKMARK2 As Integer
Dim mstrType As String, mstrMODEL As String, mintBOOKMARK4 As Integer
Dim mlngORDERID As Long, mdblTOTAL As Double
Dim mstrSQL As String
Private Sub OrderLoad()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
Dim strLine As String
On Error GoTo Error_EH
If gintORDER = 9 Then
strSQL = "SELECT * from tblOrders WHERE Lot_id = " & gintLOTID & " ORDER BY PO_Num"
End If
If gintORDER = 8 Then
strSQL = "SELECT * from tblOrders WHERE PO_Num = '" & gstrPONUM & "'"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstOrders.Clear
Do Until oRS.EOF
With lstOrders
strLine = oRS!po_num ' & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!order_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstOrders.ListCount Then
lstOrders.ListIndex = 0
txtOrdCnt = Field2Str(lstOrders.ListCount)
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAP_Click()
Dim intBookmark As Integer
moRSORDER!ap = vbTrue
moRSORDER!cocode = moRSProj!cocode
moRSORDER.Update
intBookmark = lstOrders.ListIndex
Call OrderLoad
lstOrders.ListIndex = intBookmark
End Sub
Private Sub cmdAR_Click()
Dim oRS As Recordset
Dim strSQL As String, lngINVNO As Long
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblSYSInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
lngINVNO = Field2Long(oRS!swinvno)
lngINVNO = lngINVNO + 1
If lngINVNO > 99999 Then
lngINVNO = 19999
End If
oRS!swinvno = lngINVNO
oRS.Update
moRSORDER!Vend_Inv = lngINVNO
' moRSORDER!SUP_INV = lngINVNO
txtVendorInv = lngINVNO
moRSORDER!ar = vbTrue
moRSORDER!cocode = moRSProj!cocode
moRSORDER.Update
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module cmdAR"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdFindPO_Click()
gintPONUM = Field2Long(lblD_SPO)
frmPOInfo.Show 1
End Sub
Private Sub cmdMisc_Click()
Dim strSql2 As String, strTYPE As String, strPONUM As String
Dim lngORDERID As Long, intBookmark As Integer
Dim oRSS As Recordset
On Error GoTo Error_EH
If moRSORDER!ap Then
MsgBox "AP has been transfered, No Adding Allowed", vbOKOnly, "No Adding"
Exit Sub
End If
If moRSORDER!ap_trans Then
MsgBox "AP has been transfered, No Adding Allowed", vbOKOnly, "No Adding"
Exit Sub
End If
If moRSORDER!ar Then
MsgBox "AR has been transfered, No Adding Allowed", vbOKOnly, "No Adding"
Exit Sub
End If
If moRSORDER!ar_trans Then
MsgBox "AR has been transfered, No Adding Allowed", vbOKOnly, "No Adding"
Exit Sub
End If
strSql2 = "SELECT * FROM tblORDMatrl WHERE order_id = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
' gstrMODULE = "Before Setup Materials "
With oRSS
strTYPE = moRSORDER!m_type
strPONUM = moRSORDER!po_num
lngORDERID = moRSORDER!order_id
.AddNew
!order_id = lngORDERID
!LOT_ID = gintLOTID
!po_num = strPONUM
!d_flag = "S"
!m_type = strTYPE
!inv_no = "9990"
!Desc = "MISC CHARGE - SEE NOTES"
!o_qty = 0
!a_qty = 0
!price = 0
!Update = Date
!U_USER = gstrLOGIN
!C_USER = gstrLOGIN
.Update
End With
intBookmark = lstOrders.ListIndex
Call OrderLoad
lstOrders.ListIndex = intBookmark
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module cmdMisc"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "{tblORDERS.order_id} = " & mlngORDERID
crOrder.ReportFileName = App.Path & "\POPrice.rpt"
crOrder.GroupSelectionFormula = strSQL
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module cmdPrint"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdUpdate_Click()
Dim intBOOK As Integer
On Error GoTo Error_EH
mintBOOKMARK = lstOrders.ListIndex
intBOOK = lstMaterials.ListIndex
moRSORDER!orderamt = Field2Str2(lblTotal)
moRSORDER!notes = Field2Str(txtNotes)
moRSORDER!Vend_Inv = Field2Str(txtVendorInv)
' moRSORDER!SUP_INV = Field2Str(txtVendorInv)
moRSORDER!inv_date = Field2Str(txtInvDate)
moRSORDER.Update
Call OrderLoad
Call OrderMatLoad
cmdUpdate.Enabled = False
lstOrders.ListIndex = mintBOOKMARK
lstMaterials.ListIndex = intBOOK
mintBOOKMARK = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module cmdUpdate"
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 cmdExit_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
' R Reset Purchase Order for AR(Not Allowed if VOIDED)
' P Reset Purchase Order for AP(Not Allowed if VOIDED)
' V Will Void The PO if it has not been processed
' U Update the Costs for the materials in the HiLited PO for all item numbers over 1000
' W Update the Costs for the materials in all PO's for all items numbers over 1000
' H Update the Costs for the Hi-lited inventory item.
' I Update cost for items under inventory # 1000. Will prompt for the amount and move to the next item.
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 = vbKeyR And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
If moRSORDER!d_flag = "X" Then
MsgBox "This PO Has Been Voided - Reset Not Allowed", vbCritical + vbOKOnly, "No Void Allowed"
Exit Sub
End If
moRSORDER!ar_trans = vbUnchecked
moRSORDER!ar = vbUnchecked
Call cmdUpdate_Click
End If
Exit Sub
End If
If KeyCode = vbKeyP And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
If moRSORDER!d_flag = "X" Then
MsgBox "This PO Has Been Voided - Reset Not Allowed", vbCritical + vbOKOnly, "No Void Allowed"
Exit Sub
End If
moRSORDER!ap_trans = vbUnchecked
moRSORDER!ap = vbUnchecked
Call cmdUpdate_Click
End If
Exit Sub
End If
If KeyCode = vbKeyV And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then
If CtrlDown Then
If moRSORDER!ar_trans Or moRSORDER!ap_trans Then
MsgBox "This PO Has Already Been Processed - No Void Allowed", vbCritical + vbOKOnly, "No Void Allowed"
Exit Sub
End If
Call LotChange(mstrPROJLOT, "VOID Purchase Order")
moRSORDER!m_type = "H"
moRSORDER!d_flag = "X"
moRSORDER!ar_trans = vbChecked
moRSORDER!ap_trans = vbChecked
moRSORDER.Update
Call FormShow
End If
Exit Sub
End If
If KeyCode = vbKeyU And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then
If CtrlDown Then
Call OrderMatPrices
Call OrderMatLoad
End If
Exit Sub
End If
If KeyCode = vbKeyW And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then
If CtrlDown Then
Call OrderMatPrices2
Call OrderMatLoad
End If
Exit Sub
End If
If KeyCode = vbKeyH And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then
If CtrlDown Then
Call OrderMatPrices4
mintBOOKMARK4 = lstMaterials.ListIndex
mintBOOKMARK2 = lstOrders.ListIndex
Call OrderMatLoad
lstMaterials.ListIndex = mintBOOKMARK4
lstOrders.ListIndex = mintBOOKMARK2
mintBOOKMARK4 = 0
mintBOOKMARK2 = 0
End If
Exit Sub
End If
If KeyCode = vbKeyI And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then
If CtrlDown Then
Call OrderMatPrices3
Call OrderMatLoad
End If
Exit Sub
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 = "PO 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 moRSORDER.State = adStateOpen Then
moRSORDER.Close
End If
If moRSOrdMat.State = adStateOpen Then
moRSOrdMat.Close
End If
If moRS.State = adStateOpen Then
moRS.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 OrderMatLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String, lngRET As Long, aTabs(1) As Long
Dim dblSUM As Double
On Error GoTo Error_EH
aTabs(0) = 130
aTabs(1) = 155
mdblTOTAL = 0
strSQL = "SELECT Item_id, Inv_no, Desc, A_Qty, Price from tblOrdMatrl WHERE Order_id = " & mlngORDERID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngRET = SendMessage(lstMaterials.hwnd, LB_SETTABSTOPS, 2, aTabs(0))
lstMaterials.Clear
Do Until oRS.EOF
With lstMaterials
strLine = oRS!Desc & vbTab & oRS!a_qty & vbTab & Format(oRS!price, "#,#.00")
.AddItem strLine
.ItemData(.NewIndex) = oRS!Item_ID
End With
dblSUM = (Field2Str2(oRS!a_qty) * Field2Str2(oRS!price))
mdblTOTAL = mdblTOTAL + dblSUM
oRS.MoveNext
Loop
oRS.Close
If mdblTOTAL <> Field2Str2(lblD_Amount) Then
lblD_Amount = Format(mdblTOTAL, "#,#,#.00")
moRSORDER!orderamt = mdblTOTAL
moRSORDER.Update
End If
If lstMaterials.ListCount Then
lstMaterials.ListIndex = 0
Else
lstMaterials.Clear
Call FormClearOrdMat
End If
lblTotal = Format(mdblTOTAL, "#,#.00")
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Load()
' Set moRSORDER = New Recordset
' Set moRSOrdMat = New Recordset
' If gbytSECURITY < 3 Then
' cmdUpdate.Visible = True
' End If
Call ProjLoad
Call OrderLoad
If gstrPONUM = "" Then
Else
Call CBFindString(lstOrders, gstrPONUM)
' lstOrders.SetFocus
End If
' Call ListLoad
' Call MatLoad
' Call OptLoad
' Call OptMatLoad
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
mlngORDERID = moRSORDER!order_id
glngORDERID = moRSORDER!order_id
lblProjLot = Trim$(moRSProj!Proj_Code) & " " & Trim$(moRSProj!Proj_Desc) & " " & moRS!lot_no
mstrPROJLOT = lblProjLot
With moRSORDER
txtVendorInv = Field2Str(!Vend_Inv)
' txtVendorInv = Field2Str(!SUP_INV)
txtNotes = Field2Str(!notes)
chkCalc = Field2CheckBox(!calc)
lblJobCost = Field2Str(!jobcost)
lblD_ODate = Field2Str(!order_date)
If !d_flag = "X" Then
lblD_Flag = "This PO Voided - Do Not Pay"
Else
lblD_Flag = ""
End If
If IsNull(!inv_date) Then
txtInvDate = Field2Str(!order_date)
Else
txtInvDate = Field2Str(!inv_date)
End If
lblD_PO = Field2Str(!po_num)
lblD_Supplier = Field2Str(!supplier)
lblD_SPO = Field2Long(!ponum)
lblD_Percent = Field2Str(!percentage)
lblD_Amount = Format(Field2Str2(!orderamt), "#,#.00")
If !m_type = "H" Then
lblD_Type = "ORDER REPRINTED"
ElseIf !m_type = "L" Then
lblD_Type = "LATH ORDER"
ElseIf !m_type = "A" Then
lblD_Type = "SAND ORDER"
ElseIf !m_type = "B" Then
lblD_Type = "BROWN ORDER"
ElseIf !m_type = "T" Then
lblD_Type = "TEXTURE ORDER"
ElseIf !m_type = "R" Then
lblD_Type = "SPECIAL PO"
ElseIf !m_type = "P" Then
lblD_Type = "PREORDER"
ElseIf !m_type = "S" Then
lblD_Type = "SCRATCH ORDER"
ElseIf !m_type = "V" Then
lblD_Type = "STONE VENEER ORDER"
ElseIf !m_type = "W" Then
lblD_Type = "TYPAR WRAP ORDER"
Else
lblD_Type = "UNKNOWN"
End If
lblLocked.Caption = ""
cmdAP.Caption = "Setup AP Transfer"
cmdAR.Caption = "Setup AR Transfer"
cmdAP.Enabled = True
cmdAR.Enabled = True
If !ap Then
lblLocked.Caption = "This Invoice Ready To Be Transfered To AP"
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
txtInvDate.Enabled = False
cmdAP.Caption = "AP Transfer Setup"
' cmdAR.Enabled = False
cmdAP.Enabled = False
End If
If !ap_trans Then
lblLocked.Caption = "This Invoice Has Been Transfered To AP"
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
txtInvDate.Enabled = False
cmdAP.Caption = "AP Transfered"
' If !ar_trans Then
' cmdAR.Caption = "AR Transfered"
' End If
' cmdAR.Enabled = False
cmdAP.Enabled = False
End If
If !ar Then
lblLocked.Caption = lblLocked.Caption & " This Invoice Ready To Be Transfered To AR"
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
txtInvDate.Enabled = False
cmdAR.Caption = "AR Transfer Setup"
cmdAR.Enabled = False
' cmdAP.Enabled = True
End If
If !ar_trans Then
lblLocked.Caption = lblLocked.Caption & " This Invoice Has Been Transfered To AR"
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
txtInvDate.Enabled = False
cmdAR.Caption = "AR Transfered"
cmdAR.Enabled = False
' cmdAP.Enabled = True
End If
If !ar_trans And !ap_trans Then
lblLocked.Caption = lblLocked.Caption & " And Is Now Locked"
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
txtInvDate.Enabled = False
cmdAP.Caption = "AP Transfered"
cmdAR.Caption = "AR Transfered"
cmdAR.Enabled = False
cmdAP.Enabled = False
End If
If Not !ar_trans And Not !ap_trans And Not !ap And Not !ar Then
lblLocked.Visible = False
txtVendorInv.Enabled = True
txtAQty.Enabled = True
txtPrice.Enabled = True
txtInvDate.Enabled = True
cmdAP.Caption = "Setup A&P Transfer"
cmdAR.Caption = "Setup S&W AR Transfer"
cmdAR.Enabled = True
cmdAP.Enabled = True
End If
If lblD_SPO > 0 Then
cmdFindPO.Visible = True
Else
cmdFindPO.Visible = False
End If
txtNotes = Field2Str(!notes)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowOrdMat()
On Error GoTo Error_EH
mboolSHOW = True
With moRSOrdMat
lblD_InvNo = Field2Long(!inv_no)
lblD_Desc = Field2Str(!Desc)
lblD_OQty = Field2Str(!o_qty)
txtPrice = Format$(Field2Str2(!price), "##,###.00")
txtAQty = Field2Integer(!a_qty)
lblD_Create = Field2Str(!Create)
lblD_Update = Field2Str(!Update) & " " & Field2Str(!U_USER)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FormShowMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
lblD_ODate = ""
lblD_PO = ""
lblSupplier = ""
lblD_SPO = ""
lblD_Percent = ""
lblD_Amount = ""
lblD_Type = ""
lblD_Flag = ""
End Sub
Private Sub FormClearOrdMat()
lblD_InvNo = ""
lblD_Desc = ""
lblD_OQty = 0
txtPrice = 0
txtAQty = 0
lblCreate = ""
lblUpdate = ""
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
moRSOrdMat.Update
Call OrderMatLoad
' Call ToggleButtons
Exit Sub
Error_EH:
Call ErrorHandler(moRS.ActiveConnection)
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblOrders "
strSQL = strSQL & "WHERE order_id = " & _
lstOrders.ItemData(lstOrders.ListIndex)
Set moRSORDER = New Recordset
moRSORDER.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSORDER.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Orders - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindOrdMat() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblOrdMatrl "
strSQL = strSQL & "WHERE Item_ID = " & lstMaterials.ItemData(lstMaterials.ListIndex)
Set moRSOrdMat = New Recordset
moRSOrdMat.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSOrdMat.EOF Then
FormFindOrdMat = False
txtAQty.Enabled = False
txtPrice.Enabled = False
Else
FormFindOrdMat = True
' txtAQty.Enabled = True
' txtPrice.Enabled = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Orders - Module FormFindOrdMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSOrdMat
!a_qty = Single2Field(txtAQty)
!price = Format(Single2Field(txtPrice), "#,#.00")
' If txtAQty > 0 Then
' !SWAR = True
' End If
' !notes = Str2Field(txtNotes)
!Update = Date
!U_USER = gstrLOGIN
End With
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
If lstOrders.ListCount = 0 Then
intResponse = MsgBox("No Orders Have Been Processed For This Lot", vbOKOnly + vbQuestion, "No Orders")
Unload Me
End If
End Sub
Private Sub lstMaterials_DblClick()
If Not moRSORDER!ap_trans Then
cmdSave.Enabled = True
End If
End Sub
Private Sub lstOrders_Click()
On Error GoTo Error_EH
If lstOrders.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
Call OrderMatLoad
If lstMaterials.ListIndex <> -1 Then
If FormFindOrdMat() Then
Call FormShowOrdMat
Else
lstMaterials.Clear
txtAQty.Enabled = False
txtPrice.Enabled = False
Call FormClearOrdMat
End If
Else
txtAQty.Enabled = False
txtPrice.Enabled = False
End If
Else
lstOrders.Clear
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module lstOrders_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstMaterials_Click()
On Error GoTo Error_EH
If lstMaterials.ListIndex <> -1 Then
If FormFindOrdMat() Then
Call FormShowOrdMat
Else
lstMaterials.Clear
Call FormClearOrdMat
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module lstMaterials_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjLoad()
Dim strSQL As String
Dim strSql2 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
strSql2 = "SELECT * FROM tblLotInfo WHERE Lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
Dim intBOOK As Integer
mintBOOKMARK = lstOrders.ListIndex
intBOOK = lstMaterials.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
cmdUpdate.Enabled = True
Call FormSave
lstOrders.ListIndex = mintBOOKMARK
lstMaterials.ListIndex = intBOOK
mintBOOKMARK = 0
End Sub
Private Sub lstOrders_DblClick()
If chkCalc Then
chkCalc = vbUnchecked
moRSORDER!calc = False
moRSORDER.Update
Else
chkCalc = vbChecked
moRSORDER!calc = True
moRSORDER.Update
End If
End Sub
Private Sub txtAQty_GotFocus()
Call FieldSelect(txtAQty)
End Sub
Private Sub txtInvDate_Change()
cmdUpdate.Enabled = True
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 Not IsDate(txtInvDate) Then
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
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtInvDate.SetFocus
Exit Sub
End If
End If
cmdUpdate.SetFocus
End Sub
Private Sub txtNotes_Change()
cmdUpdate.Enabled = True
End Sub
Private Sub txtNotes_GotFocus()
txtNotes.SelStart = 1000
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
txtVendorInv.SetFocus
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub
Private Sub txtVendorInv_Change()
cmdUpdate.Enabled = True
End Sub
Private Sub txtVendorInv_GotFocus()
Call FieldSelect(txtVendorInv)
End Sub
Private Sub txtVendorInv_LostFocus()
txtVendorInv = UCase(txtVendorInv)
cmdUpdate.SetFocus
End Sub
Private Sub SetupTransfer()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARINVOICE WHERE ready"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblARTRANS"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblARTRANS"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
.AddNew
!invoice_no = oRS!invoice_no
!customer_no = oRS!customer_no
!invoice_date = oRS!invoice_date
!job_number = oRS!job_number
!inv_due_date = oRS!inv_due_date
!disc_due_date = oRS!disc_due_date
!non_tax_amt = oRS!non_tax_amt
!retention_amt = oRS!retention_amt
!sales_code = oRS!sales_code
!Description = Left$(Field2Str(oRS!Description), 30)
!price = oRS!price
!amount = oRS!amount
!ready = True
!shipping = Left$(Field2Str(oRS!project), 15)
!comment = "Lot " & oRS!lot_no & "," & Left$(Field2Str(oRS!address), 20)
.Update
oRS!ready = False
oRS!done = True
oRS.Update
oRS.MoveNext
End With
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub WrapMatPrices()
Dim oRS As Recordset, oRSS As Recordset, strINV As String
Dim strSQL As String, strSQLL As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module WrapMatPrices"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderMatPrices()
Dim oRS As Recordset, oRSS As Recordset, strINV As String
Dim strSQL As String, strSQLL As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & glngORDERID
' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
If Field2Str2(oRS!price) = 0 Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatPrices"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderMatPrices2()
Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long
Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer
On Error GoTo Error_EH
intLSTCNT = Field2Integer(txtOrdCnt)
intCOUNT = 1
lstOrders.ListIndex = 0
lngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
Do Until intCOUNT = intLSTCNT
If chkCalc Then
strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & glngORDERID
' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
End If
intCOUNT = intCOUNT + 1
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatPrices2"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderMatPrices3()
Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long
Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer
On Error GoTo Error_EH
intLSTCNT = Field2Integer(txtOrdCnt)
intCOUNT = 1
lstOrders.ListIndex = 0
lngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
Do Until intCOUNT = intLSTCNT
If chkCalc Then
strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & lngORDERID & " AND INV_NO = "
' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
End If
intCOUNT = intCOUNT + 1
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatPrices3"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderMatPrices4()
Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long, strCOST As String
Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer, dblCOST As Double
Dim strDESC As String
On Error GoTo Error_EH
intLSTCNT = Field2Integer(txtOrdCnt)
' intCOUNT = 1
' lstOrders.ListIndex = 0
' lngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
' lstMaterials.ListIndex = 0
lngORDERID = lstMaterials.ItemData(lstMaterials.ListIndex)
' Do Until intCOUNT = intLSTCNT
' If chkCalc Then
strSQL = "SELECT Lot_ID, INV_NO, DESC, Price, ITEM_ID FROM tblORDMATRL WHERE ITEM_ID = " & lngORDERID ' & " AND INV_NO = "
' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
' Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
strDESC = Field2Str(oRS!Desc)
If Field2Str2(oRS!price) = 0 Then
strCOST = InputBox("Enter The New Cost For '" & Trim(Field2Str(oRS!inv_no)) & " - " & Trim(Field2Str(oRS!Desc)) & "'", "Update Material Cost", 0)
oRS!price = Field2Str2(strCOST)
oRS.Update
Else
MsgBox "Price Is Not Zero So Cannot Be Updated", vbOKOnly, "Cannot Update"
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
' strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = " & Field2Str(oRS!Inv_NO) ' & "'"
' Set oRSS = New Recordset
' oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
' If Not oRSS.EOF Then
' oRS!price = Field2Str2(oRSS!price)
' oRS.Update
' End If
' oRSS.Close
End If
' oRS.MoveNext
' Loop
End If
' End If
' intCOUNT = intCOUNT + 1
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatPrices4"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub