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

1110 lines
31 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Begin VB.Form frmYardOrder
Caption = "Yard Order Information"
ClientHeight = 6225
ClientLeft = 60
ClientTop = 345
ClientWidth = 10470
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6225
ScaleWidth = 10470
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdPopulate
Caption = "Retrieve Yard Order"
Height = 555
Left = 8040
TabIndex = 27
Top = 900
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdUpdateIssue
Caption = "Update Issue Date"
Height = 555
Left = 9240
TabIndex = 26
Top = 900
Visible = 0 'False
Width = 1155
End
Begin VB.TextBox txtMemo
Height = 1995
Left = 60
MultiLine = -1 'True
TabIndex = 10
Top = 4140
Width = 5235
End
Begin VB.TextBox txtQIssue
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6840
MaxLength = 6
TabIndex = 8
Top = 1380
Width = 855
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9240
TabIndex = 15
Top = 1500
Width = 1155
End
Begin VB.ListBox lstInv
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2010
Left = 5460
Sorted = -1 'True
TabIndex = 14
Top = 4140
Visible = 0 'False
Width = 4095
End
Begin VB.CommandButton cmdDeleteInv
Caption = "&Delete Inventory"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9240
TabIndex = 13
Top = 3300
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdSaveInv
Caption = "&Save Inventory"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9240
TabIndex = 11
Top = 2100
Width = 1155
End
Begin VB.CommandButton cmdAddInv
Caption = "&Add Inventory"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9240
TabIndex = 12
Top = 2700
Width = 1155
End
Begin VB.CommandButton cmdFindInv
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 9495
Picture = "frmYardOrder.frx":0000
Style = 1 'Graphical
TabIndex = 6
Top = 60
Visible = 0 'False
Width = 435
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6840
MaxLength = 8
TabIndex = 9
Top = 1800
Width = 855
End
Begin VB.TextBox txtDesc
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6840
MaxLength = 30
TabIndex = 7
Top = 540
Width = 3555
End
Begin VB.TextBox txtInvNo
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6840
MaxLength = 4
TabIndex = 5
Top = 120
Width = 2625
End
Begin VB.ListBox lstInventory
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3375
Left = 60
Sorted = -1 'True
TabIndex = 0
Top = 480
Width = 5235
End
Begin VB.Label lblPO_NUM
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
Height = 435
Left = 5820
TabIndex = 29
Top = 3480
Width = 3255
End
Begin VB.Label lblPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO:"
Height = 195
Left = 5400
TabIndex = 28
Top = 3600
Width = 330
End
Begin VB.Label Label1
Caption = "Yard Order Notes:"
Height = 255
Left = 120
TabIndex = 25
Top = 3900
Width = 1575
End
Begin VB.Label txtQty
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
Height = 315
Left = 6840
TabIndex = 24
Top = 960
Width = 855
End
Begin VB.Label lblQIssue
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Qty Issued:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 6000
TabIndex = 23
Top = 1440
Width = 795
End
Begin VB.Label txtIssue
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
Height = 315
Left = 6840
TabIndex = 22
Top = 3060
Width = 1275
End
Begin VB.Label txtChange
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
Height = 315
Left = 6840
TabIndex = 21
Top = 2640
Width = 1275
End
Begin VB.Label txtCreate
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty DataFormat
Type = 1
Format = "MM/dd/yyyy"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 3
EndProperty
Height = 315
Left = 6840
TabIndex = 20
Top = 2220
Width = 1275
End
Begin VB.Label lblIssued
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date Issued:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5895
TabIndex = 19
Top = 3060
Width = 900
End
Begin VB.Label lblChange
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date Qty Change:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5520
TabIndex = 18
Top = 2640
Width = 1275
End
Begin VB.Label lblCreate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date Order Printed:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5430
TabIndex = 17
Top = 2220
Width = 1365
End
Begin VB.Label lblQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Original Qty:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5940
TabIndex = 16
Top = 1020
Width = 855
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Cost:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 6435
TabIndex = 4
Top = 1860
Width = 360
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5895
TabIndex = 3
Top = 600
Width = 840
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory #:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5880
TabIndex = 2
Top = 180
Width = 855
End
Begin VB.Label lblInventory
AutoSize = -1 'True
Caption = "Yard Order Inventory Items:"
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 = 120
TabIndex = 1
Top = 180
Width = 2835
End
End
Attribute VB_Name = "frmYardOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSMat As Recordset
Dim moRSMemo As Recordset
Dim moRS As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Private Sub LoadInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Yard_id, Inv_no, Desc, qty, qtyissue, Price from tblYardOrder WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInventory.Clear
Do Until oRS.EOF
With lstInventory
' strLine = oRS!inv_no & " " & oRS!qty & vbTab & oRS!qtyissue & vbTab & oRS!Desc
strLine = oRS!inv_no & vbTab & oRS!qty & vbTab & oRS!qtyIssue & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!Yard_ID ' & oRS!qty
End With
oRS.MoveNext
Loop
oRS.Close
If lstInventory.ListCount Then
lstInventory.ListIndex = 0
cmdPopulate.Visible = False
Else
If gbytSECURITY = 1 Or gbytSECURITY = 9 Or gbytSECURITY = 8 Then
cmdPopulate.Visible = True
End If
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdFindInv_Click()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long
On Error GoTo Error_EH
If txtInvNo = "" Then
txtInvNo = 1
End If
strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtInvNo.Text & "' and Inv_Type = " & gbytINV_TYPE
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Field2Str(!price)
End With
Else
lstInv.Visible = True
Call LoadMInventory
lngFind = Field2Long(txtInvNo)
Call ListFindItem2(lstInv, lngFind)
End If
txtQIssue.SetFocus
oRS.Close
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub LoadMInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE Inv_Type = " & gbytINV_TYPE
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInv.Clear
Do Until oRS.EOF
With lstInv
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInv.ListCount Then
lstInv.ListIndex = -1
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FormClear()
txtInvNo = ""
txtDesc = ""
txtPrice = 0
txtQIssue = 0
txtQty.Caption = 0
txtCreate = ""
txtChange = ""
txtIssue = ""
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strMEMO As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblYardOrder "
strSQL = strSQL & "WHERE Yard_id = " & lstInventory.ItemData(lstInventory.ListIndex)
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
moRSMat.Open strSQL, goConn, _
adOpenKeyset, adLockOptimistic
strMEMO = "SELECT * FROM tblYardMemo where lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strMEMO, goConn, adOpenForwardOnly, adLockOptimistic
If moRSMemo.RecordCount = 0 Then
moRSMemo.AddNew
moRSMemo!LOT_ID = gintLOTID
End If
If moRSMat.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
moRSMat.Update
Resume Next
End Function
Private Sub FindLot()
Dim strSQL As String, strPlan As String, strMEMO As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblLotInfo "
strSQL = strSQL & "WHERE Lot_ID = " & gintLOTID
If moRS.State = adStateOpen Then
moRS.Close
End If
moRS.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
Exit Sub
Error_EH:
gstrMODULE = "Form YardOrder - Module FindLot"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String, strISSUE As String, strSQL As String
Dim lngPOS As Long
Dim strMEMO As String
On Error GoTo Error_EH
If mboolAdding Then
If moRSMat.State = adStateClosed Then
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblYardOrder "
strSQL = strSQL & "WHERE Yard_id = 1"
moRSMat.Open strSQL, goConn, _
adOpenKeyset, adLockOptimistic
strMEMO = "SELECT * FROM tblYardMemo where lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strMEMO, goConn, adOpenForwardOnly, adLockOptimistic
If moRSMemo.RecordCount = 0 Then
moRSMemo.AddNew
moRSMemo!LOT_ID = gintLOTID
End If
End If
moRSMat.AddNew
moRSMat!po_num = "HANDWRITTEN PO"
moRSMat!LOT_ID = gintLOTID
strISSUE = InputBox("Enter the Issue Date for This Item", "Issue Date")
lngPOS = InStr(1, strISSUE, "/", 1)
If lngPOS = 0 Then
If Len(strISSUE) > 0 Then
strISSUE = Format(strISSUE, "00/00/####")
If Not IsDate(strISSUE) Then
MsgBox "The Date You Entered is not Valid - The Issue Date as not updated"
Exit Sub
End If
Else
Exit Sub
End If
Else
MsgBox "Invalid Date Format, The Issue Date as not Updated", , "Invalid Date - ReEnter"
Exit Sub
End If
moRSMat!issued = Str2Field(strISSUE)
End If
' Store the controls to the recordset
Call FieldsSave
moRSMat.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSMat.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
With moRSMat
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Format$(Field2Str(!price), "##,###.00")
txtQty = Field2Str(!qty)
txtQIssue = Field2Str(!qtyIssue)
txtCreate = Format$(Field2Str(!created), "short date")
txtChange = Format$(Field2Str(!Updated), "short date")
txtIssue = Format$(Field2Str(!issued), "short date")
lblPO_NUM = Field2Str(!po_num)
End With
txtMemo = Field2Str(moRSMemo!notes)
mboolSHOW = False
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSMat
!inv_no = Str2Field(txtInvNo)
!Desc = Str2Field(txtDesc)
!qtyIssue = Str2Field(txtQIssue)
!price = Str2Field(txtPrice)
!Updated = Now()
!UpdateUser = gstrLOGIN
End With
moRSMemo!notes = Field2Str(txtMemo)
moRSMemo.Update
Exit Sub
Error_EH:
If Err = -2147467259 Then
Resume Next
' Exit Sub
End If
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdAddInv_Click()
cmdAddInv.Enabled = False
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = False
lstInventory.Enabled = False
mboolAdding = True
Call FormClear
txtInvNo.SetFocus
cmdFindInv.Visible = True
End Sub
Private Sub cmdDeleteInv_Click()
cmdDeleteInv.Enabled = False
cmdSaveInv.Enabled = False
cmdAddInv.Enabled = True
moRSMat.Delete
Call LoadInventory
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPopulate_Click()
Dim strSQL As String, strSELECT As String, strYARD As String, strPRICE As String
Dim oRS As Recordset, oRSS As Recordset
Dim strMSG As String, strMEMO As String
On Error GoTo Error_EH
If Date2Field(moRS!lorder) > Now() Then
strMSG = "This Lot Has Not Been Printed Yet," & vbCrLf
strMSG = strMSG & "The Yard Order Will be Populated" & vbCrLf
strMSG = strMSG & "Automatically When Printed - Call Darv"
MsgBox strMSG, vbCritical + vbOKOnly, "Call Darv"
Exit Sub
End If
strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strPRICE, goConn, adOpenKeyset, adLockOptimistic
strSQL = "SELECT inv_no, price FROM tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
Do Until oRSS.EOF
strSELECT = "inv_no = '" & Field2Str(oRSS!inv_no) & "'"
oRS.MoveFirst
oRS.Find strSELECT
If Not oRS.EOF Then
oRSS!price = Str2Field(oRS!price)
oRSS.Update
End If
oRSS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
strYARD = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strYARD, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSS.EOF
oRS.AddNew
oRS!LOT_ID = gintLOTID
oRS!inv_no = Field2Str(oRSS!inv_no)
oRS!Desc = Field2Str(oRSS!Desc)
oRS!qty = Field2Str2(oRSS!qty)
oRS!qtyIssue = Field2Str2(oRSS!qty)
oRS!price = Field2Str2(oRSS!price)
oRS!createuser = gstrLOGIN
oRS!UpdateUser = gstrLOGIN
oRS.Update
oRSS.MoveNext
Loop
txtMemo = Field2Str(txtMemo) & " YARD ORDER RETRIEVED - " & Now() & " BY " & gstrLOGIN
If moRSMemo.State = adStateClosed Then
strMEMO = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strMEMO, goConn, adOpenKeyset, adLockOptimistic
If moRSMemo.RecordCount Then
moRSMemo!notes = UCase(Field2Str(txtMemo))
moRSMemo.Update
Else
moRSMemo.AddNew
moRSMemo!LOT_ID = gintLOTID
moRSMemo!notes = UCase(Field2Str(txtMemo))
moRSMemo.Update
End If
End If
Call LoadInventory
Exit Sub
Error_EH:
gstrMODULE = "Form YardORder - Module cmdPopulate_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSaveInv_Click()
cmdSaveInv.Enabled = False
cmdDeleteInv.Enabled = False
cmdAddInv.Enabled = True
cmdFindInv.Visible = False
lstInventory.Enabled = True
Call FormSave
Call LoadInventory
End Sub
Private Sub cmdUpdateIssue_Click()
Dim oRS As Recordset
Dim strSQL As String, strISSUE As String
Dim lngPOS As Long
strISSUE = InputBox("Enter the Issue Date for this Yard Order (mmddyyyy)", "Issue Date")
lngPOS = InStr(1, strISSUE, "/", 1)
If lngPOS = 0 Then
If Len(strISSUE) > 0 Then
strISSUE = Format(strISSUE, "00/00/####")
If Not IsDate(strISSUE) Then
MsgBox "The Date You Entered is not Valid - The Issue Date as not updated"
Exit Sub
End If
Else
Exit Sub
End If
Else
MsgBox "Invalid Date Format, The Issue Date as not Updated", , "Invalid Date - ReEnter"
Exit Sub
End If
strSQL = "SELECT * FROM tblYardOrder WHERE not locked and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!issued = strISSUE
oRS!Locked = vbChecked
oRS.Update
oRS.MoveNext
Loop
Call LoadInventory
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSaveInv.Enabled Then
cmdSaveInv.Enabled = True
cmdAddInv.Enabled = False
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Set moRSMat = New Recordset
Set moRSMemo = New Recordset
Set moRS = New Recordset
Call FindLot
Call LoadInventory
If gbytSECURITY = 1 Or gbytSECURITY = 9 Or gbytSECURITY = 8 Then
cmdUpdateIssue.Visible = True
cmdAddInv.Enabled = True
' cmdSaveInv.Enabled = True
cmdFindInv.Enabled = True
End If
If gbytSECURITY = 1 Then
cmdDeleteInv.Visible = True
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 cmdSaveInv.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
End Select
End If
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub lstInv_DblClick()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc, price FROM tblInvtry where Inv_no = '" & lstInv.ItemData(lstInv.ListIndex) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Field2Str(!price)
End With
oRS.Close
txtQIssue.SetFocus
lstInv.Visible = False
If gbytSECURITY = 1 Then
cmdDeleteInv.Visible = True
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_Click()
On Error GoTo Error_EH
If lstInventory.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
End If
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_DblClick()
If gbytSECURITY = 1 Or gbytSECURITY = 9 Or gbytSECURITY = 8 Then
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = True
cmdAddInv.Enabled = False
End If
End Sub
Private Sub txtDesc_GotFocus()
Call FieldSelect(txtDesc)
End Sub
Private Sub txtDesc_LostFocus()
txtDesc = UCase(txtDesc)
End Sub
Private Sub txtInvNo_GotFocus()
Call FieldSelect(txtInvNo)
End Sub
Private Sub txtMemo_LostFocus()
txtMemo = UCase(txtMemo)
End Sub
Private Sub txtQIssue_GotFocus()
Call FieldSelect(txtQIssue)
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub
Private Sub txtQIssue_LostFocus()
Call FieldSelect(txtQIssue)
End Sub
Reference in New Issue View Git Blame Copy Permalink