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>
This commit is contained in:
@@ -0,0 +1,813 @@
|
||||
VERSION 5.00
|
||||
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
|
||||
Begin VB.Form frmPrint
|
||||
Caption = "Print Orders"
|
||||
ClientHeight = 4650
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4440
|
||||
KeyPreview = -1 'True
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 4650
|
||||
ScaleWidth = 4440
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.TextBox txtJobCost
|
||||
Height = 285
|
||||
Left = 3540
|
||||
TabIndex = 21
|
||||
Top = 2580
|
||||
Visible = 0 'False
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtNotes
|
||||
Height = 1095
|
||||
Left = 60
|
||||
MultiLine = -1 'True
|
||||
ScrollBars = 2 'Vertical
|
||||
TabIndex = 6
|
||||
Top = 2940
|
||||
Width = 4275
|
||||
End
|
||||
Begin VB.TextBox txtSupplier
|
||||
Height = 285
|
||||
Left = 2280
|
||||
TabIndex = 19
|
||||
Top = 2340
|
||||
Visible = 0 'False
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.TextBox txtCopy
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 5
|
||||
Top = 2280
|
||||
Visible = 0 'False
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.TextBox txtHeader
|
||||
Alignment = 2 'Center
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 17
|
||||
Top = 1980
|
||||
Visible = 0 'False
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.PictureBox picFoam
|
||||
AutoRedraw = -1 'True
|
||||
AutoSize = -1 'True
|
||||
Height = 1215
|
||||
Left = 2640
|
||||
ScaleHeight = 1155
|
||||
ScaleWidth = 1095
|
||||
TabIndex = 16
|
||||
Top = 645
|
||||
Visible = 0 'False
|
||||
Width = 1155
|
||||
End
|
||||
Begin Crystal.CrystalReport crPrint
|
||||
Left = 1215
|
||||
Top = 4155
|
||||
_ExtentX = 741
|
||||
_ExtentY = 741
|
||||
_Version = 348160
|
||||
PrintFileLinesPerPage= 60
|
||||
End
|
||||
Begin VB.TextBox txtDelivery
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 4
|
||||
Top = 1920
|
||||
Visible = 0 'False
|
||||
Width = 1275
|
||||
End
|
||||
Begin VB.CheckBox chkPreOrder
|
||||
Caption = "PreOrder"
|
||||
Height = 375
|
||||
Left = 1200
|
||||
TabIndex = 3
|
||||
Top = 1440
|
||||
Visible = 0 'False
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtPO
|
||||
Height = 315
|
||||
Left = 3840
|
||||
TabIndex = 14
|
||||
Top = 2160
|
||||
Visible = 0 'False
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtDFlag
|
||||
Height = 345
|
||||
Left = 3900
|
||||
TabIndex = 13
|
||||
Top = 1740
|
||||
Visible = 0 'False
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.TextBox txtOrderDate
|
||||
Height = 315
|
||||
Left = 1200
|
||||
MaxLength = 10
|
||||
TabIndex = 1
|
||||
Top = 660
|
||||
Width = 1275
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "&Cancel"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 12
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 3300
|
||||
TabIndex = 8
|
||||
Top = 4140
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.CommandButton cmdPrint
|
||||
Caption = "&Print"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 12
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 4125
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.TextBox txtMFlag
|
||||
Height = 285
|
||||
Left = 3900
|
||||
TabIndex = 12
|
||||
Top = 1320
|
||||
Visible = 0 'False
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.TextBox txtPONum
|
||||
Height = 285
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 1320
|
||||
Visible = 0 'False
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.ComboBox cboSupplier
|
||||
Height = 315
|
||||
Left = 1200
|
||||
Sorted = -1 'True
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 2
|
||||
Top = 1020
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.Label lblNotes
|
||||
AutoSize = -1 'True
|
||||
Caption = "Notes to Print On 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 = 195
|
||||
Left = 120
|
||||
TabIndex = 20
|
||||
Top = 2700
|
||||
Width = 1860
|
||||
End
|
||||
Begin VB.Label lblCopy
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Copies:"
|
||||
Height = 195
|
||||
Left = 600
|
||||
TabIndex = 18
|
||||
Top = 2340
|
||||
Visible = 0 'False
|
||||
Width = 525
|
||||
End
|
||||
Begin VB.Label lblDelivery
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Foam Cut Date:"
|
||||
Height = 195
|
||||
Left = 15
|
||||
TabIndex = 15
|
||||
Top = 1980
|
||||
Visible = 0 'False
|
||||
Width = 1110
|
||||
End
|
||||
Begin VB.Label lblTitle
|
||||
Alignment = 2 'Center
|
||||
Caption = "Lath Order"
|
||||
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 = 60
|
||||
TabIndex = 10
|
||||
Top = 120
|
||||
Width = 4335
|
||||
End
|
||||
Begin VB.Label lblSupplier
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Supplier:"
|
||||
Height = 195
|
||||
Left = 510
|
||||
TabIndex = 9
|
||||
Top = 1080
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblOrderDate
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Delivery Date:"
|
||||
Height = 195
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 720
|
||||
Width = 1005
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmPrint"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Dim mboolJPG As Boolean
|
||||
Dim moRSOrders As Recordset
|
||||
'Dim moRS As Recordset
|
||||
|
||||
Private Sub SupplierLoad()
|
||||
Dim oRS As Recordset
|
||||
Dim strSQL As String, strFLAG As String
|
||||
On Error GoTo Error_EH
|
||||
'If needed to load suppliers for Wrap, changes will need to be done here
|
||||
|
||||
If gstrTYPE = "Y" Then
|
||||
strFLAG = "L"
|
||||
ElseIf gstrTYPE = "S" Then
|
||||
strFLAG = "S"
|
||||
ElseIf gstrTYPE = "A" Then
|
||||
strFLAG = "A"
|
||||
End If
|
||||
If gstrTYPE = "Y" And strFLAG = "L" And Not gstrFLAG = "P" Then
|
||||
gstrTYPE = "S"
|
||||
End If
|
||||
strSQL = "SELECT * FROM tblSupplier where type = '" & strFLAG & "'"
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSQL, goConn, _
|
||||
adOpenForwardOnly, adLockReadOnly
|
||||
|
||||
Do Until oRS.EOF
|
||||
cboSupplier.AddItem oRS!supplier
|
||||
cboSupplier.ItemData(cboSupplier.NewIndex) = Field2Long(oRS!sup_no)
|
||||
oRS.MoveNext
|
||||
Loop
|
||||
oRS.Close
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Print - Module SupplierLoad"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub cboSupplier_Change()
|
||||
If cboSupplier.ListIndex = -1 Then
|
||||
Exit Sub
|
||||
End If
|
||||
If gstrFLAG = "P" And (cboSupplier.ItemData(cboSupplier.ListIndex) = 16 Or cboSupplier.ItemData(cboSupplier.ListIndex) = 15) Then
|
||||
chkPreOrder.Visible = True
|
||||
lblDelivery.Visible = True
|
||||
txtDelivery.Visible = True
|
||||
End If
|
||||
If cboSupplier.ItemData(cboSupplier.ListIndex) = 18 Then
|
||||
chkPreOrder.Visible = True
|
||||
lblDelivery.Visible = True
|
||||
txtDelivery.Visible = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cboSupplier_Click()
|
||||
If cboSupplier.ListIndex = -1 Then
|
||||
Exit Sub
|
||||
End If
|
||||
If gstrFLAG = "P" And (cboSupplier.ItemData(cboSupplier.ListIndex) = 16 Or cboSupplier.ItemData(cboSupplier.ListIndex) = 15) Then
|
||||
chkPreOrder.Visible = True
|
||||
lblDelivery.Visible = True
|
||||
txtDelivery.Visible = True
|
||||
Else
|
||||
chkPreOrder.Visible = False
|
||||
lblDelivery.Visible = False
|
||||
txtDelivery.Visible = False
|
||||
chkPreOrder = vbUnchecked
|
||||
txtDelivery = ""
|
||||
End If
|
||||
' If cboSupplier.ItemData(cboSupplier.ListIndex) = 18 Then
|
||||
' chkPreOrder.Visible = True
|
||||
' lblDelivery.Visible = True
|
||||
' txtDelivery.Visible = True
|
||||
' Else
|
||||
' chkPreOrder.Visible = False
|
||||
' lblDelivery.Visible = False
|
||||
' txtDelivery.Visible = False
|
||||
' chkPreOrder = vbUnchecked
|
||||
' txtDelivery = ""
|
||||
' End If
|
||||
End Sub
|
||||
|
||||
Private Sub cboSupplier_LostFocus()
|
||||
If cboSupplier.ListIndex = -1 Then
|
||||
Exit Sub
|
||||
End If
|
||||
If gstrFLAG = "P" And (cboSupplier.ItemData(cboSupplier.ListIndex) = 16 Or cboSupplier.ItemData(cboSupplier.ListIndex) = 15) Then
|
||||
chkPreOrder.Visible = True
|
||||
lblDelivery.Visible = True
|
||||
txtDelivery.Visible = True
|
||||
Else
|
||||
chkPreOrder.Visible = False
|
||||
lblDelivery.Visible = False
|
||||
txtDelivery.Visible = False
|
||||
chkPreOrder = vbUnchecked
|
||||
txtDelivery = ""
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub chkPreOrder_Click()
|
||||
If chkPreOrder = vbChecked Then
|
||||
lblDelivery.Visible = False
|
||||
txtDelivery.Visible = False
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub chkPreOrder_LostFocus()
|
||||
If chkPreOrder = vbChecked Then
|
||||
lblDelivery.Visible = False
|
||||
txtDelivery.Visible = False
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
gboolPRINT = False
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPrint_Click()
|
||||
|
||||
|
||||
On Error GoTo Error_EH
|
||||
If Not IsDate(txtOrderDate) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtOrderDate.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
Call FormSave
|
||||
If cboSupplier.ListIndex <> -1 Then
|
||||
If gstrFLAG = "P" And (cboSupplier.ItemData(cboSupplier.ListIndex) = 16 Or cboSupplier.ItemData(cboSupplier.ListIndex) = 15) Then
|
||||
' If gintCOCODE = 0 Then
|
||||
Call FoamPrint
|
||||
' ElseIf gintCOCODE = 1 Then
|
||||
' Call FoamPrint
|
||||
' End If
|
||||
' moRS!y_flg = "P"
|
||||
' moRS.Update
|
||||
gboolPRINT = False
|
||||
Unload Me
|
||||
Exit Sub
|
||||
End If
|
||||
If cboSupplier.ItemData(cboSupplier.ListIndex) = 18 Or cboSupplier.ItemData(cboSupplier.ListIndex) = 17 Then
|
||||
Call YardPrint
|
||||
' moRS!y_flg = "P"
|
||||
' moRS.Update
|
||||
gboolPRINT = False
|
||||
Unload Me
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Unload Me
|
||||
Exit Sub
|
||||
Error_EH:
|
||||
gstrMODULE = gstrMODULE & " Form Print - Module cmdPrint"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
' cmdExit.Enabled = True
|
||||
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_Load()
|
||||
|
||||
If gstrFLAG = "A" Then
|
||||
lblTitle.Caption = "SAND ORDER"
|
||||
ElseIf gstrFLAG = "T" Then
|
||||
lblTitle.Caption = "TEXTURE ORDER"
|
||||
ElseIf gstrFLAG = "S" Then
|
||||
lblTitle.Caption = "SCRATCH ORDER"
|
||||
ElseIf gstrFLAG = "B" Then
|
||||
lblTitle.Caption = "BROWN ORDER"
|
||||
ElseIf gstrFLAG = "P" Then
|
||||
lblTitle.Caption = "MATERIALS PREORDER"
|
||||
ElseIf gstrFLAG = "V" Then
|
||||
lblTitle.Caption = "STONE VENEER ORDER"
|
||||
ElseIf gstrFLAG = "R" Then
|
||||
lblTitle.Caption = "SPECIAL PURCHASE ORDER"
|
||||
ElseIf gstrFLAG = "W" Then
|
||||
lblTitle.Caption = "WRAP ORDER"
|
||||
ElseIf gstrFLAG = "E" Then
|
||||
lblTitle.Caption = "SYNTHETIC ORDER"
|
||||
ElseIf gstrFLAG = "Z" Then
|
||||
lblTitle.Caption = "PRE-CAST ORDER"
|
||||
End If
|
||||
|
||||
txtCopy = gintCOPY
|
||||
Call SupplierLoad
|
||||
If gstrPO <> "L" Then 'Need to decide if this needs to address W also
|
||||
cboSupplier.Visible = False
|
||||
lblSupplier.Visible = False
|
||||
lblCopy.Visible = True
|
||||
txtCopy.Visible = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub FormSave()
|
||||
Dim strSQL As String, mdblORDAMT As Double, strSELECT As String
|
||||
Dim oRS As Recordset, oRSS As Recordset
|
||||
Dim strPRICE As String, strDate As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
gstrPONUM = ""
|
||||
strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and M_Type = '" & Str2Field(txtMFlag) & "'"
|
||||
Set oRSS = New Recordset
|
||||
oRSS.Open strPRICE, goConn, adOpenKeyset, adLockOptimistic
|
||||
If Not cboSupplier.ListIndex = -1 Then
|
||||
strSQL = "SELECT inv_no, price, sup_no FROM tblINVPrice WHERE Sup_no = " & cboSupplier.ItemData(cboSupplier.ListIndex)
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
||||
If Not oRS.EOF Then
|
||||
Do Until oRSS.EOF
|
||||
strSELECT = "inv_no = " & Field2Integer(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
|
||||
End If
|
||||
oRSS.Close
|
||||
|
||||
strSELECT = "SELECT SUM(qty*price) as SUMORDER FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and M_Type = '" & Str2Field(txtMFlag) & "'"
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
mdblORDAMT = Field2Str2(oRS!sumorder)
|
||||
|
||||
strSQL = "SELECT * FROM tblOrders WHERE lot_id = 1"
|
||||
Set moRSOrders = New Recordset
|
||||
moRSOrders.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
||||
|
||||
moRSOrders.AddNew
|
||||
moRSOrders!Lot_id = gintLOTID
|
||||
If gstrPO = "L" Then
|
||||
moRSOrders!supplier = Str2Field(cboSupplier.List(cboSupplier.ListIndex))
|
||||
ElseIf gstrPO = "W" Then
|
||||
moRSOrders!supplier = "SUPERWALL INC."
|
||||
Else
|
||||
moRSOrders!supplier = Field2Str(txtSupplier)
|
||||
End If
|
||||
moRSOrders!order_date = Str2Field(txtOrderDate)
|
||||
If moRSOrders!PrintDate = "01/01/2000" Or IsNull(moRSOrders!PrintDate) Then
|
||||
strDate = Date
|
||||
moRSOrders!PrintDate = Date
|
||||
End If
|
||||
If gstrFLAG = "L" Then
|
||||
moRSOrders!Print = vbChecked
|
||||
End If
|
||||
moRSOrders!m_type = gstrFLAG
|
||||
moRSOrders!d_flag = Str2Field(txtDFlag)
|
||||
moRSOrders!po_num = Str2Field(txtPONum)
|
||||
moRSOrders!ponum = Str2Field(txtPO)
|
||||
moRSOrders!orderamt = Format(Round(mdblORDAMT, 2), "#,#.00")
|
||||
moRSOrders!notes = Str2Field(txtNotes)
|
||||
moRSOrders!percentage = gintPERCENT
|
||||
moRSOrders!jobcost = Field2Str(txtJobCost)
|
||||
If chkPreOrder Then
|
||||
moRSOrders!preorder = vbChecked
|
||||
moRSOrders!foam = vbChecked
|
||||
End If
|
||||
If IsDate(txtDelivery) Then
|
||||
moRSOrders!cut_date = Str2Field(txtDelivery)
|
||||
End If
|
||||
moRSOrders.Update
|
||||
|
||||
gstrPONUM = Str2Field(txtPONum)
|
||||
|
||||
strSELECT = "SELECT MAX(Order_id) as MAXORDER FROM tblOrders" ' WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and M_Type = '" & Str2Field(txtMFlag) & "'"
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
glngORDERID = Field2Str2(oRS!MAXOrder)
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
Call ErrorHandler(moRSOrders.ActiveConnection)
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub picFoam_Change()
|
||||
mboolJPG = True
|
||||
End Sub
|
||||
|
||||
Private Sub txtCopy_GotFocus()
|
||||
Call FieldSelect(txtCopy)
|
||||
End Sub
|
||||
|
||||
Private Sub txtCopy_LostFocus()
|
||||
gintCOPY = Field2Integer(txtCopy)
|
||||
End Sub
|
||||
|
||||
Private Sub txtDelivery_GotFocus()
|
||||
Call FieldSelect(txtDelivery)
|
||||
End Sub
|
||||
|
||||
Private Sub txtDelivery_LostFocus()
|
||||
If IsDate(txtDelivery) Then
|
||||
Exit Sub
|
||||
End If
|
||||
If Len(txtDelivery) > 0 Then
|
||||
txtDelivery = Format(txtDelivery, "00/##/####")
|
||||
If Not IsDate(txtDelivery) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtDelivery.SetFocus
|
||||
ElseIf CDate(txtDelivery) < Date Then
|
||||
MsgBox "The Date You Entered is Earlier Than Today - ReEnter"
|
||||
txtDelivery.SetFocus
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub txtNotes_LostFocus()
|
||||
txtNotes = UCase(txtNotes)
|
||||
End Sub
|
||||
|
||||
Private Sub txtOrderDate_GotFocus()
|
||||
|
||||
Call FieldSelect(txtOrderDate)
|
||||
End Sub
|
||||
|
||||
Private Sub txtOrderDate_LostFocus()
|
||||
If IsDate(txtOrderDate) Then
|
||||
Exit Sub
|
||||
End If
|
||||
If Len(txtOrderDate) > 0 Then
|
||||
txtOrderDate = Format(txtOrderDate, "00/##/####")
|
||||
If Not IsDate(txtOrderDate) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtOrderDate.SetFocus
|
||||
ElseIf CDate(txtOrderDate) < Date Then
|
||||
MsgBox "The Date You Entered is Earlier Than Today - ReEnter"
|
||||
txtOrderDate.SetFocus
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub FoamPrint()
|
||||
Dim strSQL As String
|
||||
Dim strSELECT As String, oRSS As Recordset
|
||||
|
||||
On Error GoTo Error_EH:
|
||||
|
||||
If gintCOCODE = 0 Then
|
||||
If txtPO = 0 Then
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder.rpt"
|
||||
strSQL = "{tblLOTMATRL.LOT_ID} = " & gintLOTID
|
||||
Else
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder2.rpt"
|
||||
strSQL = "{tblPOrder.PONum} = " & CInt(txtPO)
|
||||
End If
|
||||
ElseIf gintCOCODE = 1 Then
|
||||
If txtPO = 0 Then
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrderM.rpt"
|
||||
strSQL = "{tblLOTMATRL.LOT_ID} = " & gintLOTID
|
||||
Else
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder2M.rpt"
|
||||
strSQL = "{tblPOrder.PONum} = " & CInt(txtPO)
|
||||
End If
|
||||
End If
|
||||
crPrint.ReplaceSelectionFormula (strSQL)
|
||||
crPrint.CopiesToPrinter = 1
|
||||
' crPrint.Destination = crptToWindow
|
||||
crPrint.Destination = crptToPrinter
|
||||
If chkPreOrder Then
|
||||
crPrint.Formulas(0) = "datestring = 'DATE TO CUT: '"
|
||||
crPrint.Formulas(1) = "datevalue = 'PREORDER'"
|
||||
crPrint.Formulas(2) = "PO = '" & gstrPONUM & "'"
|
||||
crPrint.Formulas(3) = "title = 'FOAM CUT SHEET'"
|
||||
Else
|
||||
crPrint.Formulas(0) = "datestring = 'DATE TO CUT: '"
|
||||
crPrint.Formulas(1) = "datevalue = '" & txtDelivery & "'"
|
||||
crPrint.Formulas(2) = "PO = '" & gstrPONUM & "'"
|
||||
crPrint.Formulas(3) = "title = 'FOAM CUT SHEET'"
|
||||
End If
|
||||
crPrint.Action = 1
|
||||
|
||||
crPrint.Reset
|
||||
If gintCOCODE = 0 Then
|
||||
If txtPO = 0 Then
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder.rpt"
|
||||
strSQL = "{tblLOTMATRL.LOT_ID} = " & gintLOTID
|
||||
Else
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder2.rpt"
|
||||
strSQL = "{tblPOrder.PONum} = " & CInt(txtPO)
|
||||
End If
|
||||
ElseIf gintCOCODE = 1 Then
|
||||
If txtPO = 0 Then
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrderM.rpt"
|
||||
strSQL = "{tblLOTMATRL.LOT_ID} = " & gintLOTID
|
||||
Else
|
||||
crPrint.ReportFileName = App.Path & "\FoamPreOrder2M.rpt"
|
||||
strSQL = "{tblPOrder.PONum} = " & CInt(txtPO)
|
||||
End If
|
||||
End If
|
||||
' If txtPO = 0 Then
|
||||
' crPrint.ReportFileName = App.Path & "\FoamPreOrder.rpt"
|
||||
' Else
|
||||
' crPrint.ReportFileName = App.Path & "\FoamPreOrder2.rpt"
|
||||
' End If
|
||||
' crPrint.ReportFileName = App.Path & "\FoamPreOrder.rpt"
|
||||
crPrint.ReplaceSelectionFormula (strSQL)
|
||||
crPrint.CopiesToPrinter = 1
|
||||
' crPrint.Destination = crptToWindow
|
||||
crPrint.Destination = crptToPrinter
|
||||
crPrint.Formulas(0) = "datestring = 'DATE TO DELIVER: '"
|
||||
crPrint.Formulas(1) = "datevalue = ' '"
|
||||
crPrint.Formulas(2) = "PO = '" & gstrPONUM & "'"
|
||||
crPrint.Formulas(3) = "title = 'FOAM DELIVERY SHEET'"
|
||||
crPrint.Action = 1
|
||||
|
||||
' PrintJPG
|
||||
|
||||
If txtPO <> 0 Then
|
||||
strSELECT = "SELECT * FROM tblPOrder WHERE PONum = " & CInt(txtPO) ' & " and p_flg <> 'P'"
|
||||
Set oRSS = New Recordset
|
||||
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
|
||||
oRSS!p_flg = "P"
|
||||
oRSS.Update
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Print - Module FoamPrint"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub YardPrint()
|
||||
Dim strSQL As String, mdblORDAMT As Double, strSELECT As String
|
||||
Dim oRS As Recordset, oRSS As Recordset
|
||||
Dim strPRICE As String
|
||||
Dim strYARD As String
|
||||
|
||||
On Error GoTo Error_EH:
|
||||
|
||||
strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = 1"
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
|
||||
|
||||
strYARD = "SELECT * FROM tblPOrdMat WHERE ponum = " & CInt(txtPO)
|
||||
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!po_num = gstrPONUM
|
||||
oRS!createuser = gstrLOGIN
|
||||
oRS!UpdateUser = gstrLOGIN
|
||||
oRS.Update
|
||||
oRSS.MoveNext
|
||||
Loop
|
||||
|
||||
oRS.Close
|
||||
oRSS.Close
|
||||
|
||||
If gintCOCODE = 0 Then
|
||||
crPrint.ReportFileName = App.Path & "\POYard.rpt"
|
||||
ElseIf gintCOCODE = 1 Then
|
||||
crPrint.ReportFileName = App.Path & "\POYardM.rpt"
|
||||
End If
|
||||
strSQL = "{tblPOrder.PONum} = " & CInt(txtPO)
|
||||
crPrint.ReplaceSelectionFormula (strSQL)
|
||||
crPrint.CopiesToPrinter = 1
|
||||
' crPrint.Destination = crptToWindow
|
||||
crPrint.Destination = crptToPrinter
|
||||
crPrint.Action = 1
|
||||
|
||||
crPrint.Reset
|
||||
|
||||
If txtPO <> 0 Then
|
||||
strSELECT = "SELECT * FROM tblPOrder WHERE PONum = " & CInt(txtPO) ' & " and p_flg <> 'P'"
|
||||
Set oRSS = New Recordset
|
||||
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
|
||||
oRSS!p_flg = "P"
|
||||
oRSS.Update
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Print - Module YardPrint"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub PrintJPG()
|
||||
Dim strSQL As String, oRS As Recordset, strFile As String
|
||||
|
||||
' On Error GoTo Error_EH:
|
||||
|
||||
' mboolJPG = False
|
||||
' If txtPO = 0 Then
|
||||
' strSQL = "SELECT Inv_No, Lot_ID, d_flag, m_type FROM tblLotMatrl WHERE D_Flag = 'Y' and M_Type = 'P' and Lot_Id = " & gintLOTID
|
||||
' Set oRS = New Recordset
|
||||
' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
' Else
|
||||
' strSQL = "SELECT Inv_No, d_flag, m_type, PONum FROM tblPOrdMat where D_Flag = 'Y' and M_Type = 'P' and PONum = " & Field2Integer(txtPO)
|
||||
' Set oRS = New Recordset
|
||||
' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
' End If
|
||||
|
||||
' Do Until oRS.EOF
|
||||
' strFile = "\pictures\" & Field2Str(oRS!inv_no) & ".JPG"
|
||||
' If Not mboolJPG Then
|
||||
' MsgBox "No Foam Diagram File Found", vbOKOnly, "No File"
|
||||
' Exit Sub
|
||||
' End If
|
||||
' picFoam.Picture = LoadPicture(App.Path & strFile)
|
||||
' txtHeader = "FOAM SHAPE " & Field2Str(oRS!inv_no)
|
||||
' epFoam.Margin(epTop) = 1.5
|
||||
' Set epFoam.HeaderText = txtHeader
|
||||
' Set epFoam.PictureSource = picFoam
|
||||
' epFoam.epPrint
|
||||
' oRS.MoveNext
|
||||
' Loop
|
||||
' Exit Sub
|
||||
|
||||
'Error_EH:
|
||||
' gstrMODULE = "Form Print - Module PrintJPG"
|
||||
' Call ErrorHandler2
|
||||
' gstrMODULE = ""
|
||||
' Exit Sub
|
||||
End Sub
|
||||
Reference in New Issue
Block a user