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,756 @@
|
||||
VERSION 5.00
|
||||
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
|
||||
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
|
||||
Begin VB.Form frmFoam
|
||||
Caption = "Foam Orders"
|
||||
ClientHeight = 3540
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 10965
|
||||
KeyPreview = -1 'True
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 3540
|
||||
ScaleWidth = 10965
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CheckBox chkDelivery
|
||||
Caption = "Un-Delivered Orders Only"
|
||||
Height = 315
|
||||
Left = 5700
|
||||
TabIndex = 17
|
||||
Top = 60
|
||||
Width = 2235
|
||||
End
|
||||
Begin VB.CheckBox chkPreOrder
|
||||
Caption = "PreOrders Only"
|
||||
Height = 315
|
||||
Left = 3780
|
||||
TabIndex = 16
|
||||
Top = 60
|
||||
Width = 1695
|
||||
End
|
||||
Begin Crystal.CrystalReport CRDaily
|
||||
Left = 9060
|
||||
Top = 0
|
||||
_ExtentX = 741
|
||||
_ExtentY = 741
|
||||
_Version = 348160
|
||||
PrintFileLinesPerPage= 60
|
||||
End
|
||||
Begin VB.CommandButton cmdPrint
|
||||
Caption = "&Print"
|
||||
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 = 9960
|
||||
TabIndex = 15
|
||||
Top = 2880
|
||||
Width = 915
|
||||
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 = 8940
|
||||
TabIndex = 14
|
||||
Top = 2880
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save"
|
||||
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 = 7920
|
||||
TabIndex = 13
|
||||
Top = 2880
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.TextBox txtCutDate
|
||||
Alignment = 1 'Right Justify
|
||||
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 = 315
|
||||
Left = 9120
|
||||
TabIndex = 4
|
||||
Top = 2100
|
||||
Width = 1755
|
||||
End
|
||||
Begin VB.TextBox txtDelDate
|
||||
Alignment = 1 'Right Justify
|
||||
Height = 315
|
||||
Left = 9120
|
||||
TabIndex = 5
|
||||
Top = 2460
|
||||
Width = 1755
|
||||
End
|
||||
Begin VB.TextBox txtODate
|
||||
Alignment = 1 'Right Justify
|
||||
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 = 315
|
||||
Left = 9120
|
||||
TabIndex = 3
|
||||
Top = 1740
|
||||
Width = 1755
|
||||
End
|
||||
Begin VB.ListBox lstOrders
|
||||
Height = 2985
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 480
|
||||
Width = 7455
|
||||
End
|
||||
Begin MSComCtl2.DTPicker dtpODate
|
||||
Height = 315
|
||||
Left = 1320
|
||||
TabIndex = 1
|
||||
Top = 60
|
||||
Width = 2115
|
||||
_ExtentX = 3731
|
||||
_ExtentY = 556
|
||||
_Version = 393216
|
||||
Format = 48824321
|
||||
CurrentDate = 37138
|
||||
End
|
||||
Begin VB.Label lblVWPPO
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "VWP P.O.:"
|
||||
Height = 195
|
||||
Left = 8295
|
||||
TabIndex = 12
|
||||
Top = 1440
|
||||
Width = 780
|
||||
End
|
||||
Begin VB.Label lblDTime
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Cut Date:"
|
||||
Height = 195
|
||||
Left = 8400
|
||||
TabIndex = 11
|
||||
Top = 2160
|
||||
Width = 675
|
||||
End
|
||||
Begin VB.Label lblConfirm
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Delivery Date:"
|
||||
Height = 195
|
||||
Left = 8070
|
||||
TabIndex = 10
|
||||
Top = 2520
|
||||
Width = 1005
|
||||
End
|
||||
Begin VB.Label lblOrder
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Order Date:"
|
||||
Height = 195
|
||||
Left = 8250
|
||||
TabIndex = 9
|
||||
Top = 1800
|
||||
Width = 825
|
||||
End
|
||||
Begin VB.Label lblPO
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 9120
|
||||
TabIndex = 8
|
||||
Top = 1380
|
||||
Width = 1755
|
||||
End
|
||||
Begin VB.Label lblProjLot
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 495
|
||||
Left = 7860
|
||||
TabIndex = 7
|
||||
Top = 840
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.Label lblSupplier
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 7860
|
||||
TabIndex = 6
|
||||
Top = 480
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.Label lblODate
|
||||
Alignment = 1 'Right Justify
|
||||
AutoSize = -1 'True
|
||||
Caption = "Order Date:"
|
||||
Height = 195
|
||||
Left = 330
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 825
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmFoam"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Dim moRSORDER As Recordset
|
||||
Dim moRS As Recordset, moRSProj As Recordset
|
||||
|
||||
Dim mboolSHOW As Boolean, mboolAdding As Boolean
|
||||
Dim mlngORDERID As Long, mintBOOKMARK As Integer
|
||||
Dim mstrPROJLOT As String
|
||||
|
||||
Private Sub OrderLoad()
|
||||
Dim oRS As Recordset, oRSS As Recordset, oRSP As Recordset
|
||||
Dim strSQL As String, strSql2 As String, strSQL3 As String
|
||||
Dim strTYPE As String, strFLAG As String
|
||||
Dim strLine As String
|
||||
On Error GoTo Error_EH
|
||||
|
||||
If chkPreOrder Then
|
||||
strSQL = "SELECT Order_ID, lot_id, order_date, Cut_date, Del_date, Foam from tblOrders WHERE Order_Date >= #" & CDate(dtpODate.Value) & "# AND foam AND preorder"
|
||||
ElseIf chkDelivery Then
|
||||
strSQL = "SELECT Order_ID, lot_id, order_date, Cut_date, Del_date, Foam from tblOrders WHERE Order_Date >= #" & CDate(dtpODate.Value) & "# AND foam and isnull(del_date)"
|
||||
Else
|
||||
strSQL = "SELECT Order_ID, lot_id, order_date, Cut_date, Del_date, Foam from tblOrders WHERE Order_Date >= #" & CDate(dtpODate.Value) & "# AND FOAM"
|
||||
End If
|
||||
Set oRS = New Recordset
|
||||
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
|
||||
lstOrders.Clear
|
||||
|
||||
Do Until oRS.EOF
|
||||
With lstOrders
|
||||
strSql2 = "SELECT Proj_id, Lot_id, Lot_no FROM tblLotInfo WHERE lot_id = " & oRS!Lot_id
|
||||
Set oRSS = New Recordset
|
||||
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
|
||||
If Not oRSS.EOF Then
|
||||
strSQL3 = "SELECT Proj_id, Proj_Desc FROM tblProject where Proj_id = " & oRSS!proj_id
|
||||
Set oRSP = New Recordset
|
||||
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
|
||||
End If
|
||||
|
||||
strLine = ""
|
||||
strLine = Field2Str(oRS!order_date) & vbTab & IIf(Len(Field2Str(oRS!cut_date)) > 0, Field2Str(oRS!cut_date), "PREORDER")
|
||||
strLine = strLine & vbTab & IIf(Len(Field2Str(oRS!del_date)) > 0, Field2Str(oRS!del_date), " NOT DEL ")
|
||||
strLine = strLine & vbTab & Field2Str(oRSP!proj_desc) & " " & Field2Str(oRSS!lot_no)
|
||||
|
||||
.AddItem strLine
|
||||
.ItemData(.NewIndex) = oRS!order_id
|
||||
End With
|
||||
|
||||
oRS.MoveNext
|
||||
Loop
|
||||
oRS.Close
|
||||
|
||||
If lstOrders.ListCount Then
|
||||
lstOrders.ListIndex = 0
|
||||
mlngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
|
||||
Else
|
||||
mlngORDERID = 0
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module OrderLoad"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub chkDelivery_Click()
|
||||
Call OrderLoad
|
||||
If FormFind() Then
|
||||
' Call ProjectSelect
|
||||
' Call LotSelect
|
||||
Call FormShow
|
||||
Else
|
||||
Call FormClear
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub chkPreOrder_Click()
|
||||
Call OrderLoad
|
||||
If FormFind() Then
|
||||
Call FormShow
|
||||
Else
|
||||
Call FormClear
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdExit_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPrint_Click()
|
||||
Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
strMONTH = Format(Month(dtpODate.Value), "00")
|
||||
strDAY = Format(Day(dtpODate.Value), "00")
|
||||
strYEAR = Year(dtpODate.Value)
|
||||
gintPRINT = 1
|
||||
frmReport.Show 1
|
||||
strSQL = "{tblorders.order_date} = date (" & strYEAR & "," & strMONTH & "," & strDAY & ")" '"
|
||||
'{tblORDERS.ORDER_DATE} = Date (2001,09,06)
|
||||
CRDaily.ReportFileName = App.Path & "\Dailyorders.rpt"
|
||||
CRDaily.GroupSelectionFormula = strSQL
|
||||
' crdaily.Destination = crptToWindow
|
||||
CRDaily.CopiesToPrinter = gintCOPY
|
||||
CRDaily.Destination = gintDEST
|
||||
CRDaily.Action = 1
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module cmdPrint_Click"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
|
||||
mintBOOKMARK = lstOrders.ListIndex
|
||||
Call FormSave
|
||||
cmdSave.Enabled = False
|
||||
lstOrders.Enabled = True
|
||||
lstOrders.ListIndex = mintBOOKMARK
|
||||
mintBOOKMARK = 0
|
||||
End Sub
|
||||
|
||||
Private Sub dtpODate_Change()
|
||||
Call OrderLoad
|
||||
If FormFind() Then
|
||||
' Call ProjectSelect
|
||||
' Call LotSelect
|
||||
Call FormShow
|
||||
Else
|
||||
Call FormClear
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
|
||||
If Shift = 4 Then
|
||||
Exit Sub
|
||||
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()
|
||||
Dim strSQL As String
|
||||
Dim oRS As Recordset
|
||||
On Error GoTo Error_EH
|
||||
|
||||
Set moRSORDER = New Recordset
|
||||
dtpODate.Value = Date
|
||||
|
||||
Call OrderLoad
|
||||
' If FormFind() Then
|
||||
' Call ProjectSelect
|
||||
' Call LotSelect
|
||||
' Call FormShow
|
||||
' Else
|
||||
' Call FormClear
|
||||
' End If
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module Form_Load"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Function FormFind() As Boolean
|
||||
Dim strSQL As String, strPlan As String, strMEMO As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
|
||||
strSQL = "SELECT * "
|
||||
strSQL = strSQL & "FROM tblOrders "
|
||||
strSQL = strSQL & "WHERE order_ID = " & mlngORDERID
|
||||
|
||||
Set moRSORDER = New Recordset
|
||||
moRSORDER.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
||||
|
||||
If moRSORDER.EOF Then
|
||||
FormFind = False
|
||||
Else
|
||||
FormFind = True
|
||||
gintLOTID = Field2Str2(moRSORDER!Lot_id)
|
||||
End If
|
||||
Exit Function
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module FormFind"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
Private Sub FormShow()
|
||||
Dim mstrAREA As String
|
||||
Dim strSQL As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
lblProjLot.Caption = ""
|
||||
lblSupplier.Caption = ""
|
||||
lblPO.Caption = ""
|
||||
|
||||
mboolSHOW = True
|
||||
strSQL = "Select * FROM tblLotInfo WHERE Lot_id = " & gintLOTID
|
||||
Set moRS = New Recordset
|
||||
moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
||||
gintPROJID = Field2Str2(moRS!proj_id)
|
||||
|
||||
strSQL = "Select * FROM tblProject WHERE proj_id = " & gintPROJID
|
||||
Set moRSProj = New Recordset
|
||||
moRSProj.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
||||
|
||||
lblProjLot.Caption = Trim(Field2Str(moRSProj!proj_desc)) & " " & Field2Str(moRS!lot_no)
|
||||
|
||||
With moRSORDER
|
||||
txtODate = Field2Str(!order_date)
|
||||
txtCutDate = Field2Str(!cut_date)
|
||||
txtDelDate = Field2Str(!del_date)
|
||||
lblSupplier.Caption = Field2Str(!supplier)
|
||||
lblPO.Caption = Field2Str(!po_num)
|
||||
End With
|
||||
|
||||
' Call GetLotInfo
|
||||
|
||||
mboolSHOW = False
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module FormShow"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub FieldsSave()
|
||||
Dim strLOT As String
|
||||
On Error GoTo Error_EH
|
||||
|
||||
With moRSORDER
|
||||
!del_date = Str2Field(txtDelDate)
|
||||
End With
|
||||
|
||||
moRSORDER.Update
|
||||
|
||||
If FormFind() Then
|
||||
Call FormShow 'xxxxxxxxxxxxxxxxxx
|
||||
Else
|
||||
Call FormClear
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
If Err.Number = -2147467259 Then
|
||||
' MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
|
||||
' strLOT = InputBox("Enter a New Lot Number", "Fix Duplicate")
|
||||
' If Len(strLOT) > 0 Then
|
||||
' moRS!lot_no = Field2Str(strLOT)
|
||||
' moRS.Update
|
||||
' txtLotNo = Field2Str(strLOT)
|
||||
' End If
|
||||
Resume Next
|
||||
End If
|
||||
gstrMODULE = "Form Foam - Module FieldsSave"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub FormClear()
|
||||
txtODate = ""
|
||||
txtCutDate = ""
|
||||
txtDelDate = ""
|
||||
lblSupplier.Caption = ""
|
||||
lblPO.Caption = ""
|
||||
lblProjLot.Caption = ""
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub FormSave()
|
||||
Dim strName As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
|
||||
' If mboolAdding Then
|
||||
' moRSORDER.AddNew
|
||||
' moRSORDER!proj_id = gintPROJID
|
||||
' moRSORDER!lot_id = gintLOTID
|
||||
' moRSORDER!proj_lot = mstrPROJLOT
|
||||
' End If
|
||||
|
||||
' Store the controls to the recordset
|
||||
Call FieldsSave
|
||||
|
||||
moRSORDER.Update
|
||||
|
||||
Call OrderLoad
|
||||
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module FormSave"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
|
||||
If moRSORDER.State = adStateOpen Then
|
||||
moRSORDER.Close
|
||||
End If
|
||||
' If moRS.State = adStateOpen Then
|
||||
' moRS.Close
|
||||
' End If
|
||||
' If moRSProj.State = adStateOpen Then
|
||||
' moRSProj.Close
|
||||
' End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub lstOrders_Click()
|
||||
On Error GoTo Error_EH
|
||||
|
||||
If lstOrders.ListIndex <> -1 Then
|
||||
mlngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
|
||||
If FormFind() Then
|
||||
Call FormShow
|
||||
Else
|
||||
Call FormClear
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module lstOrders_Click"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub lstOrders_DblClick()
|
||||
cmdSave.Enabled = True
|
||||
End Sub
|
||||
|
||||
Private Sub txtCutDate_GotFocus()
|
||||
Call FieldSelect(txtCutDate)
|
||||
End Sub
|
||||
|
||||
Private Sub txtCutDate_LostFocus()
|
||||
Dim lngPOS As Long
|
||||
If IsDate(txtCutDate) Then
|
||||
Exit Sub
|
||||
End If
|
||||
lngPOS = InStr(1, txtCutDate, "/", 1)
|
||||
If lngPOS = 0 Then
|
||||
If Len(txtCutDate) > 0 Then
|
||||
txtCutDate = Format(txtCutDate, "00/00/####")
|
||||
If Not IsDate(txtCutDate) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtCutDate.SetFocus
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
|
||||
txtCutDate.SetFocus
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub txtDelDate_GotFocus()
|
||||
Call FieldSelect(txtCutDate)
|
||||
End Sub
|
||||
|
||||
Private Sub txtDelDate_LostFocus()
|
||||
Dim lngPOS As Long
|
||||
If IsDate(txtDelDate) Then
|
||||
Exit Sub
|
||||
End If
|
||||
lngPOS = InStr(1, txtDelDate, "/", 1)
|
||||
If lngPOS = 0 Then
|
||||
If Len(txtDelDate) > 0 Then
|
||||
txtDelDate = Format(txtDelDate, "00/00/####")
|
||||
If Not IsDate(txtDelDate) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtDelDate.SetFocus
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
|
||||
txtDelDate.SetFocus
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub txtODate_GotFocus()
|
||||
Call FieldSelect(txtODate)
|
||||
End Sub
|
||||
|
||||
Private Sub txtODate_LostFocus()
|
||||
Dim lngPOS As Long
|
||||
If IsDate(txtODate) Then
|
||||
Exit Sub
|
||||
End If
|
||||
lngPOS = InStr(1, txtODate, "/", 1)
|
||||
If lngPOS = 0 Then
|
||||
If Len(txtODate) > 0 Then
|
||||
txtODate = Format(txtODate, "00/00/####")
|
||||
If Not IsDate(txtODate) Then
|
||||
MsgBox "The Date You Entered is not Valid - ReEnter"
|
||||
txtODate.SetFocus
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
|
||||
txtODate.SetFocus
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub GetLotInfo()
|
||||
Dim strSQL As String, strSELECT As String
|
||||
|
||||
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
|
||||
|
||||
Set moRS = New Recordset
|
||||
|
||||
moRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
|
||||
|
||||
If Not moRS.EOF Then
|
||||
strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Long(moRS!proj_id)
|
||||
' strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Integer(moRS!proj_id)
|
||||
|
||||
Set moRSProj = New Recordset
|
||||
|
||||
moRSProj.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic
|
||||
|
||||
End If
|
||||
|
||||
gintPROJID = moRSProj!proj_id
|
||||
mstrPROJLOT = Trim(Field2Str(moRSProj!proj_desc)) & " - " & Trim(Field2Str(moRS!lot_no))
|
||||
' lblProjectLot = mstrPROJLOT
|
||||
End Sub
|
||||
|
||||
Private Sub LotSelect()
|
||||
Dim strSQL As String, strLine As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
|
||||
strSQL = "SELECT Lot_no, address, owner, lot_id FROM tblLotInfo WHERE proj_id = " & gintPROJID
|
||||
|
||||
Set moRS = New Recordset
|
||||
moRS.Open strSQL, goConn, _
|
||||
adOpenForwardOnly, adLockReadOnly
|
||||
|
||||
' lstLot.Visible = True
|
||||
' lstLot.Clear
|
||||
|
||||
Do Until moRS.EOF
|
||||
strLine = ""
|
||||
strLine = Field2Str(moRS!lot_no) & vbTab & Field2Str(moRS!address)
|
||||
' lstLot.AddItem strLine
|
||||
' lstLot.ItemData(lstLot.NewIndex) = Field2Long(moRS!lot_id)
|
||||
moRS.MoveNext
|
||||
Loop
|
||||
' cboRCrew.ListIndex = 0
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module LotSelect"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub ProjectSelect()
|
||||
Dim oRS As Recordset
|
||||
Dim strSQL As String
|
||||
|
||||
On Error GoTo Error_EH
|
||||
|
||||
strSQL = "SELECT Proj_id, Proj_Desc FROM tblProject"
|
||||
|
||||
Set oRS = New Recordset
|
||||
|
||||
oRS.Open strSQL, goConn, _
|
||||
adOpenForwardOnly, adLockReadOnly
|
||||
|
||||
' lstProject.Visible = True
|
||||
' lstProject.Clear
|
||||
|
||||
Do Until oRS.EOF
|
||||
' lstProject.AddItem oRS!proj_desc
|
||||
' lstProject.ItemData(lstProject.NewIndex) = Field2Long(oRS!proj_id)
|
||||
oRS.MoveNext
|
||||
Loop
|
||||
oRS.Close
|
||||
Exit Sub
|
||||
|
||||
Error_EH:
|
||||
gstrMODULE = "Form Foam - Module ProjectSelect"
|
||||
Call ErrorHandler2
|
||||
gstrMODULE = ""
|
||||
Exit Sub
|
||||
|
||||
End Sub
|
||||
|
||||
Reference in New Issue
Block a user