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/frmOrderDates.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

1225 lines
36 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Begin VB.Form frmOrderDates
Caption = "Lot Date Information"
ClientHeight = 5925
ClientLeft = 60
ClientTop = 405
ClientWidth = 5415
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5925
ScaleWidth = 5415
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdRePrint
Caption = "RePrint"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3780
TabIndex = 27
Top = 2235
Visible = 0 'False
Width = 1395
End
Begin VB.Frame fraEdit
Height = 4080
Left = 3060
TabIndex = 17
Top = 210
Width = 435
Begin VB.OptionButton optSB
Height = 195
Left = 120
TabIndex = 24
Top = 3630
Width = 195
End
Begin VB.OptionButton optLB
Height = 195
Left = 120
TabIndex = 23
Top = 2805
Width = 195
End
Begin VB.OptionButton optTexture
Height = 195
Left = 120
TabIndex = 22
Top = 2265
Width = 195
End
Begin VB.OptionButton optScratch
Height = 195
Left = 120
TabIndex = 21
Top = 1740
Width = 195
End
Begin VB.OptionButton optBrown
Height = 195
Left = 120
TabIndex = 20
Top = 1245
Width = 195
End
Begin VB.OptionButton optSand
Height = 195
Left = 120
TabIndex = 19
Top = 735
Width = 195
End
Begin VB.OptionButton optLO
Height = 195
Left = 105
TabIndex = 18
Top = 210
Value = -1 'True
Width = 195
End
End
Begin VB.TextBox txtSandDate
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 2
Top = 840
Width = 1335
End
Begin VB.CommandButton cmdEdit
Caption = "E&dit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3780
TabIndex = 9
Top = 1275
Visible = 0 'False
Width = 1395
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3780
TabIndex = 8
Top = 3195
Visible = 0 'False
Width = 1395
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 = 615
Left = 3780
TabIndex = 16
TabStop = 0 'False
Top = 315
Width = 1395
End
Begin VB.TextBox txtStuccoBill
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 7
Top = 3735
Width = 1335
End
Begin VB.TextBox txtLathBill
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 6
Top = 2955
Width = 1335
End
Begin VB.TextBox txtTextureDate
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 5
Top = 2430
Width = 1335
End
Begin VB.TextBox txtScratchDate
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 4
Top = 1875
Width = 1335
End
Begin VB.TextBox txtBrownDate
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 3
Top = 1380
Width = 1335
End
Begin VB.TextBox txtLathOrder
Enabled = 0 'False
Height = 315
Left = 1680
MaxLength = 10
TabIndex = 1
Top = 315
Width = 1335
End
Begin Crystal.CrystalReport crOrder
Left = 60
Top = 840
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.Label lblStartDate
Alignment = 2 'Center
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 = 270
Left = 285
TabIndex = 32
Top = 0
Width = 4875
End
Begin VB.Label lblStuccoPO
Height = 480
Left = 75
TabIndex = 31
Top = 4080
Visible = 0 'False
Width = 1455
End
Begin VB.Label lblLathPO
Height = 450
Left = 45
TabIndex = 30
Top = 3285
Visible = 0 'False
Width = 1455
End
Begin VB.Label lblStuccoInv
Height = 315
Left = 1695
TabIndex = 29
Top = 4065
Width = 1335
End
Begin VB.Label lblLathInv
Height = 315
Left = 1695
TabIndex = 28
Top = 3315
Width = 1335
End
Begin VB.Label txtTTLYds
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 = 315
Left = 1680
TabIndex = 26
Top = 4515
Width = 1335
End
Begin VB.Label lblTtlYds
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Total Yards:"
Height = 195
Left = 660
TabIndex = 25
Top = 4575
Width = 855
End
Begin VB.Label lblStuccoBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Billing Date:"
Height = 195
Left = 120
TabIndex = 15
Top = 3795
Width = 1395
End
Begin VB.Label lblLathBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Billing Date:"
Height = 195
Left = 315
TabIndex = 14
Top = 3030
Width = 1200
End
Begin VB.Label lblTextureDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Texture Date:"
Height = 195
Left = 540
TabIndex = 13
Top = 2490
Width = 975
End
Begin VB.Label lblScratchDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scratch Date:"
Height = 195
Left = 525
TabIndex = 12
Top = 1965
Width = 990
End
Begin VB.Label lblBrownDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Brown Date:"
Height = 195
Left = 630
TabIndex = 11
Top = 1440
Width = 885
End
Begin VB.Label lblSandDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sand Date:"
Height = 195
Left = 705
TabIndex = 10
Top = 900
Width = 810
End
Begin VB.Label lblLathDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Date:"
Height = 195
Left = 765
TabIndex = 0
Top = 375
Width = 750
End
End
Attribute VB_Name = "frmOrderDates"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRS As Recordset, mstrTexture As String, mstrBrown As String, mstrSand As String, mstrLath As String
Dim mboolSHOW As Boolean, mstrScratch As String
Dim strCHECK As String
Private Sub cmdEdit_Click()
If gbytSECURITY < 3 Then
If optLO Then
txtLathOrder.Enabled = True
txtLathOrder.SetFocus
cmdSave.Visible = True
ElseIf optSand Then
txtSandDate.Enabled = True
txtSandDate.SetFocus
cmdSave.Visible = True
ElseIf optBrown Then
txtBrownDate.Enabled = True
txtBrownDate.SetFocus
cmdSave.Visible = True
ElseIf optScratch Then
txtScratchDate.Enabled = True
txtScratchDate.SetFocus
cmdSave.Visible = True
ElseIf optTexture Then
txtTextureDate.Enabled = True
txtTextureDate.SetFocus
cmdSave.Visible = True
ElseIf optLB Then
txtLathBill.Enabled = True
txtLathBill.SetFocus
cmdSave.Visible = True
ElseIf optSB Then
txtStuccoBill.Enabled = True
txtStuccoBill.SetFocus
cmdSave.Visible = True
End If
End If
If gbytSECURITY = 6 Then
If optLO Then
txtLathOrder.Enabled = True
txtLathOrder.SetFocus
cmdSave.Visible = True
ElseIf optSand Then
txtSandDate.Enabled = True
txtSandDate.SetFocus
cmdSave.Visible = True
ElseIf optBrown Then
txtBrownDate.Enabled = True
txtBrownDate.SetFocus
cmdSave.Visible = True
ElseIf optScratch Then
txtScratchDate.Enabled = True
txtScratchDate.SetFocus
cmdSave.Visible = True
ElseIf optTexture Then
txtTextureDate.Enabled = True
txtTextureDate.SetFocus
cmdSave.Visible = True
ElseIf optLB Then
txtLathBill.Enabled = True
txtLathBill.SetFocus
cmdSave.Visible = True
ElseIf optSB Then
txtStuccoBill.Enabled = True
txtStuccoBill.SetFocus
cmdSave.Visible = True
End If
End If
If gbytSECURITY = 7 Then
If optLB Then
txtLathBill.Enabled = True
txtLathBill.SetFocus
cmdSave.Visible = True
ElseIf optSB Then
txtStuccoBill.Enabled = True
txtStuccoBill.SetFocus
cmdSave.Visible = True
End If
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdRePrint_Click()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
'***** Need to make information for LOTINFO5 get updated when updating print dates for brown and sand and texture
If optSand Then
If txtBrownDate = "" Then
strSQL = "SELECT * FROM tblOrders WHERE percentage = 100 and m_type = 'A' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!m_type = "H"
oRS!d_flag = "X"
oRS!ar_trans = vbChecked
oRS!ap_trans = vbChecked
oRS!notes = " Order Not Printed & Reset On " & Now() & " by " & gstrLOGIN
oRS.Update
oRS.MoveNext
Loop
moRS!a_flg = vbFalse
moRS!Border = Null
moRS.Update
txtSandDate = ""
Else
MsgBox "Brown Date Must Be ReSet First", vbOKOnly, "Reset Brown"
Exit Sub
End If
ElseIf optBrown Then
If txtScratchDate = "" And txtTextureDate = "" Then
strSQL = "SELECT * FROM tblOrders WHERE percentage = 100 and m_type = 'B' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!m_type = "H"
oRS!d_flag = "X"
oRS!ar_trans = vbChecked
oRS!ap_trans = vbChecked
oRS!notes = " Order Not Printed & Reset On " & Now() & " by " & gstrLOGIN
oRS.Update
oRS.MoveNext
Loop
moRS!b_flg = vbFalse
moRS!forder = Null
moRS!BrownP = vbFalse
moRS!BrownD = vbFalse
moRS.Update
txtBrownDate = ""
Else
MsgBox "Scratch/Texture Date Must Be ReSet First", vbOKOnly, "Reset Dates"
Exit Sub
End If
ElseIf optScratch Then
If txtTextureDate = "" Then
strSQL = "SELECT * FROM tblOrders WHERE percentage = 100 and m_type = 'S' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!m_type = "H"
oRS!d_flag = "X"
oRS!ar_trans = vbChecked
oRS!ap_trans = vbChecked
oRS!notes = " Order Not Printed & Reset On " & Now() & " by " & gstrLOGIN
oRS.Update
oRS.MoveNext
Loop
moRS!c_flg = vbFalse
moRS!ScratchP = vbFalse
moRS!ScratchD = vbFalse
moRS!TORDER = Null
moRS.Update
txtScratchDate = ""
Else
MsgBox "Texture Date Must Be ReSet First", vbOKOnly, "Reset Dates"
Exit Sub
End If
ElseIf optLB Then
Call RePrintLathInv
ElseIf optSB Then
Call RePrintStuccoInv
ElseIf optTexture Then
strSQL = "SELECT * FROM tblOrders WHERE percentage = 100 and m_type = 'T' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!m_type = "H"
oRS!d_flag = "X"
oRS!ar_trans = vbChecked
oRS!ap_trans = vbChecked
oRS!notes = " Order Not Printed & Reset On " & Now() & " by " & gstrLOGIN
oRS.Update
oRS.MoveNext
Loop
moRS!t_flg = vbFalse
moRS!SORDER = Null
moRS!TexP = vbFalse
moRS!TexD = vbFalse
moRS.Update
txtTextureDate = ""
strSQL = "DELETE * FROM tblARInvoice where Inv_Type = 'S' and lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblARInvoice where Inv_Type = 'V' and lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblARInvoice where Inv_Type = 'C' and lot_id = " & gintLOTID
goConn.Execute strSQL
End If
txtLathOrder.Enabled = False
txtSandDate.Enabled = False
txtBrownDate.Enabled = False
txtScratchDate.Enabled = False
txtTextureDate.Enabled = False
txtLathBill.Enabled = False
txtStuccoBill.Enabled = False
cmdSave.Visible = False
cmdRePrint.Visible = False
Call FieldsSave
End Sub
Private Sub cmdSave_Click()
txtLathOrder.Enabled = False
txtSandDate.Enabled = False
txtBrownDate.Enabled = False
txtScratchDate.Enabled = False
txtTextureDate.Enabled = False
txtLathBill.Enabled = False
txtStuccoBill.Enabled = False
cmdSave.Visible = False
Call FieldsSave
End Sub
Private Sub Form_Load()
On Error GoTo Error_EH
If gbytSECURITY < 3 Then
optLO.Enabled = True
optBrown.Enabled = True
optSand.Enabled = True
optScratch.Enabled = True
optTexture.Enabled = True
optLB.Enabled = True
optSB.Enabled = True
fraEdit.Visible = True
cmdEdit.Visible = True
ElseIf gbytSECURITY = 6 Then
optLO.Enabled = True
optBrown.Enabled = True
optSand.Enabled = True
optScratch.Enabled = True
optTexture.Enabled = True
fraEdit.Visible = True
cmdEdit.Visible = True
ElseIf gbytSECURITY = 7 Then
optLB.Enabled = True
optSB.Enabled = True
fraEdit.Visible = True
cmdEdit.Visible = True
End If
If FormFind() Then
Call FormShow
End If
Exit Sub
Error_EH:
gstrMODULE = "Form OrderDates - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblLotInfo "
strSQL = strSQL & "WHERE Lot_ID = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRS.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form OrderDates - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShow()
Dim strSQL As String, oRS As Recordset, strLathINV As String, strSuccoINV As String
On Error GoTo Error_EH
mboolSHOW = True
lblStartDate = "STARTDATE -- " & Field2Str(moRS!startdate)
With moRS
txtLathOrder = IIf(Field2Str(!lorder) = "12:00:00 AM", "", Field2Str(!lorder))
txtSandDate = IIf(Field2Str(!Border) = "12:00:00 AM", "", Field2Str(!Border))
txtScratchDate = IIf(Field2Str(!TORDER) = "12:00:00 AM", "", Field2Str(!TORDER))
txtBrownDate = IIf(Field2Str(!forder) = "12:00:00 AM", "", Field2Str(!forder))
txtTextureDate = IIf(Field2Str(!SORDER) = "12:00:00 AM", "", Field2Str(!SORDER))
txtLathBill = IIf(Field2Str(!billdt_L) = "12:00:00 AM", "", Field2Str(!billdt_L))
txtStuccoBill = IIf(Field2Str(!billdt_S) = "12:00:00 AM", "", Field2Str(!billdt_S))
txtTTLYds = Field2Str(!sq_yd)
End With
strSQL = "SELECT Lot_id, Invoice_NO, Inv_Type, Header, PO_NUM FROM tblARINVOICE WHERE INV_TYPE = 'L' AND LOT_ID = " & Field2Str2(moRS!Lot_id)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
lblLathInv = Field2Str(oRS!invoice_no)
lblLathPO = Field2Str(oRS!po_num)
End If
oRS.Close
strSQL = "SELECT Lot_id, Invoice_NO, Inv_Type, Header, PO_NUM FROM tblARINVOICE WHERE HEADER AND INV_TYPE = 'S' AND LOT_ID = " & Field2Str2(moRS!Lot_id)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
lblStuccoInv = Field2Str(oRS!invoice_no)
lblStuccoPO = Field2Str(oRS!po_num)
End If
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form OrderDates - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub optBrown_Click()
cmdRePrint.Visible = True
End Sub
Private Sub optLB_Click()
' If gbytSECURITY < 3 Then
If gbytSECURITY < 3 Or gstrLOGIN = "JDV" Then
If Len(lblLathInv) > 2 Then
cmdRePrint.Visible = True
End If
End If
End Sub
Private Sub optSand_Click()
cmdRePrint.Visible = True
End Sub
Private Sub optSB_Click()
' If gbytSECURITY < 3 Then
If gbytSECURITY < 3 Or gstrLOGIN = "JDV" Then
If Len(lblStuccoInv) > 2 Then
cmdRePrint.Visible = True
End If
End If
End Sub
Private Sub optScratch_Click()
cmdRePrint.Visible = True
End Sub
Private Sub optTexture_Click()
cmdRePrint.Visible = True
End Sub
Private Sub txtBrownDate_GotFocus()
Call FieldSelect(txtBrownDate)
mstrBrown = txtBrownDate
End Sub
Private Sub txtBrownDate_LostFocus()
Dim lngPOS As Long
' If Len(txtBrownDate) < 3 Then
' MsgBox "You Must Enter A Valid Date. It Cannot Be Blank", vbOKOnly, "InValid Date"
' txtBrownDate = mstrBrown
' txtBrownDate.SetFocus
' Exit Sub
' End If
If IsDate(txtBrownDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtBrownDate, "/", 1)
If lngPOS = 0 Then
If Len(txtBrownDate) > 0 Then
txtBrownDate = Format(txtBrownDate, "00/00/####")
If Not IsDate(txtBrownDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtBrownDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtBrownDate.SetFocus
End If
End Sub
Private Sub txtBrownDate_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtBrownDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtBrownDate, "/", 1)
If lngPOS = 0 Then
If Len(txtBrownDate) > 0 Then
txtBrownDate = Format(txtBrownDate, "00/00/####")
If Not IsDate(txtBrownDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtBrownDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtBrownDate.SetFocus
End If
End Sub
Private Sub txtLathBill_GotFocus()
Call FieldSelect(txtLathBill)
End Sub
Private Sub txtLathBill_LostFocus()
Dim lngPOS As Long
If IsDate(txtLathBill) Then
Exit Sub
End If
lngPOS = InStr(1, txtLathBill, "/", 1)
If lngPOS = 0 Then
If Len(txtLathBill) > 0 Then
txtLathBill = Format(txtLathBill, "00/00/####")
If Not IsDate(txtLathBill) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtLathBill.SetFocus
Exit Sub
Else
txtLathBill.Enabled = False
' cmdLathBilling.Enabled = False
End If
moRS!billdt_L = Str2Field(txtLathBill)
moRS.Update
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtLathBill.SetFocus
End If
End Sub
Private Sub txtLathBill_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtLathBill) Then
Exit Sub
End If
lngPOS = InStr(1, txtLathBill, "/", 1)
If lngPOS = 0 Then
If Len(txtLathBill) > 0 Then
txtLathBill = Format(txtLathBill, "00/00/####")
If Not IsDate(txtLathBill) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtLathBill.SetFocus
Exit Sub
Else
txtLathBill.Enabled = False
' cmdLathBilling.Enabled = False
End If
moRS!billdt_L = Str2Field(txtLathBill)
moRS.Update
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtLathBill.SetFocus
End If
End Sub
Private Sub txtLathOrder_GotFocus()
Call FieldSelect(txtLathOrder)
End Sub
Private Sub txtLathOrder_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtLathOrder) Then
Exit Sub
End If
lngPOS = InStr(1, txtLathOrder, "/", 1)
If lngPOS = 0 Then
If Len(txtLathOrder) > 0 Then
txtLathOrder = Format(txtLathOrder, "00/00/####")
If Not IsDate(txtLathOrder) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtLathOrder.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtLathOrder.SetFocus
End If
End Sub
Private Sub txtSandDate_GotFocus()
Call FieldSelect(txtSandDate)
' mstrSand = txtSandDate
End Sub
Private Sub txtSandDate_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtSandDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtSandDate, "/", 1)
If lngPOS = 0 Then
If Len(txtSandDate) > 0 Then
txtSandDate = Format(txtSandDate, "00/00/####")
If Not IsDate(txtSandDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtSandDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtSandDate.SetFocus
End If
End Sub
Private Sub txtScratchDate_GotFocus()
Call FieldSelect(txtScratchDate)
' mstrScratch = txtScratchDate
End Sub
Private Sub txtScratchDate_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtScratchDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtScratchDate, "/", 1)
If lngPOS = 0 Then
If Len(txtScratchDate) > 0 Then
txtScratchDate = Format(txtScratchDate, "00/00/####")
If Not IsDate(txtScratchDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScratchDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtScratchDate.SetFocus
End If
End Sub
Private Sub txtStuccoBill_GotFocus()
Call FieldSelect(txtStuccoBill)
End Sub
Private Sub txtStuccoBill_LostFocus()
Dim lngPOS As Long
If IsDate(txtStuccoBill) Then
Exit Sub
End If
lngPOS = InStr(1, txtStuccoBill, "/", 1)
If lngPOS = 0 Then
If Len(txtStuccoBill) > 0 Then
txtStuccoBill = Format(txtStuccoBill, "00/00/####")
If Not IsDate(txtStuccoBill) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtStuccoBill.SetFocus
Exit Sub
Else
txtStuccoBill.Enabled = False
End If
moRS!billdt_S = Str2Field(txtStuccoBill)
moRS.Update
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtStuccoBill.SetFocus
End If
End Sub
Private Sub txtLathOrder_LostFocus()
Dim lngPOS As Long
If Len(txtLathOrder) < 3 Then
MsgBox "You Must Enter A Valid Date. It Cannot Be Blank", vbOKOnly, "InValid Date"
txtLathOrder = mstrLath
txtLathOrder.SetFocus
Exit Sub
End If
If IsDate(txtLathOrder) Then
Exit Sub
End If
lngPOS = InStr(1, txtLathOrder, "/", 1)
If lngPOS = 0 Then
If Len(txtLathOrder) > 0 Then
txtLathOrder = Format(txtLathOrder, "00/00/####")
If Not IsDate(txtLathOrder) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtLathOrder.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtLathOrder.SetFocus
End If
End Sub
Private Sub txtSandDate_LostFocus()
Dim lngPOS As Long
If Len(txtSandDate) < 3 Then
MsgBox "You Must Enter A Valid Date. It Cannot Be Blank", vbOKOnly, "InValid Date"
txtSandDate = mstrSand
txtSandDate.SetFocus
Exit Sub
End If
If IsDate(txtSandDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtSandDate, "/", 1)
If lngPOS = 0 Then
If Len(txtSandDate) > 0 Then
txtSandDate = Format(txtSandDate, "00/00/####")
If Not IsDate(txtSandDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtSandDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtSandDate.SetFocus
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 txtScratchDate_LostFocus()
Dim lngPOS As Long
' If Len(txtScratchDate) < 3 Then
' MsgBox "You Must Enter A Valid Date. It Cannot Be Blank", vbOKOnly, "InValid Date"
' txtScratchDate = mstrScratch
' txtScratchDate.SetFocus
' Exit Sub
' End If
If IsDate(txtScratchDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtScratchDate, "/", 1)
If lngPOS = 0 Then
If Len(txtScratchDate) > 0 Then
txtScratchDate = Format(txtScratchDate, "00/00/####")
If Not IsDate(txtScratchDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScratchDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtScratchDate.SetFocus
End If
End Sub
Private Sub txtStuccoBill_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtStuccoBill) Then
Exit Sub
End If
lngPOS = InStr(1, txtStuccoBill, "/", 1)
If lngPOS = 0 Then
If Len(txtStuccoBill) > 0 Then
txtStuccoBill = Format(txtStuccoBill, "00/00/####")
If Not IsDate(txtStuccoBill) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtStuccoBill.SetFocus
Exit Sub
Else
txtStuccoBill.Enabled = False
End If
moRS!billdt_S = Str2Field(txtStuccoBill)
moRS.Update
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtStuccoBill.SetFocus
End If
End Sub
Private Sub txtTextureDate_GotFocus()
Call FieldSelect(txtTextureDate)
' mstrTexture = txtTextureDate
End Sub
Private Sub txtTextureDate_LostFocus()
Dim lngPOS As Long
' If Len(txtTextureDate) < 3 Then
' MsgBox "You Must Enter A Valid Date. It Cannot Be Blank", vbOKOnly, "InValid Date"
' txtTextureDate = mstrTexture
' txtTextureDate.SetFocus
' Exit Sub
' End If
If IsDate(txtTextureDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtTextureDate, "/", 1)
If lngPOS = 0 Then
If Len(txtTextureDate) > 0 Then
txtTextureDate = Format(txtTextureDate, "00/00/####")
If Not IsDate(txtTextureDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtTextureDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtTextureDate.SetFocus
End If
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRS
!lorder = Date2Field(txtLathOrder)
!SORDER = Str2Field(txtTextureDate)
!Border = Str2Field(txtSandDate)
!TORDER = Str2Field(txtScratchDate)
!forder = Str2Field(txtBrownDate)
!billdt_L = Str2Field(txtLathBill)
!billdt_S = Str2Field(txtStuccoBill)
!LUUser = gstrLOGIN
!Update = Date
End With
moRS.Update
Exit Sub
Error_EH:
gstrMODULE = "Form OrderDates - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub txtTextureDate_Validate(Cancel As Boolean)
Dim lngPOS As Long
If IsDate(txtTextureDate) Then
Exit Sub
End If
lngPOS = InStr(1, txtTextureDate, "/", 1)
If lngPOS = 0 Then
If Len(txtTextureDate) > 0 Then
txtTextureDate = Format(txtTextureDate, "00/00/####")
If Not IsDate(txtTextureDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtTextureDate.SetFocus
Exit Sub
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtTextureDate.SetFocus
End If
End Sub
Private Sub RePrintLathInv()
Dim strSELECT As String
gintCOPY = 1
' If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & lblLathPO & "'"
' strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
' ElseIf moRSProj!cocode = 1 Then
' strSELECT = "{tblARInvoiceM.po_num} = '" & lblLathPO & "'"
' strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
' End If
' strSELECT = "{tblARInvoice.invoice_no} = '" & mstrINV & "'"
' crOrder.ReportFileName = App.Path & "\invoice.rpt"
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
'End If
End Sub
Private Sub RePrintStuccoInv()
Dim strSELECT As String
' If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & lblStuccoPO & "'"
' strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
' ElseIf moRSProj!cocode = 1 Then
' strSELECT = "{tblARInvoiceM.po_num} = '" & lblStuccoPO & "'"
' strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
' crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
' End If
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
End Sub
Reference in New Issue View Git Blame Copy Permalink