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

1201 lines
36 KiB
Plaintext
Raw Permalink Blame History

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"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmAck
Caption = "Daily Orders"
ClientHeight = 5595
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5595
ScaleWidth = 11880
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkAPRpt
Caption = "Print AP Report"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 8160
TabIndex = 31
Top = 480
Width = 1815
End
Begin VB.TextBox txtProcess
Alignment = 1 'Right Justify
Height = 315
Left = 10080
TabIndex = 30
Top = 2760
Width = 1755
End
Begin VB.CheckBox chkPrintDate
Caption = "Use Print Date"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6360
TabIndex = 28
Top = 480
Width = 1695
End
Begin VB.CheckBox chkPrtLBOnly
Caption = "Print Lath && Brown Only"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 27
Top = 480
Width = 2415
End
Begin LpLib.fpList lstOrders
Height = 4770
Left = 0
TabIndex = 26
Top = 720
Width = 8535
_Version = 196608
_ExtentX = 15055
_ExtentY = 8414
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 7
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 300
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmAck.frx":0000
End
Begin VB.CheckBox chkSingle
Caption = "Print for Selected Supplier && Sequence Only"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 23
Top = 0
Width = 4575
End
Begin VB.CheckBox chkPrint
Caption = "Print for SW"
Height = 375
Left = 10560
TabIndex = 22
Top = 3840
Width = 1155
End
Begin VB.CommandButton cmdDeliver
Caption = "Delivery Sheet"
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 = 10800
TabIndex = 21
Top = 4800
Width = 915
End
Begin VB.CommandButton cmdUpdate
Caption = "Update Supplier"
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 = 8760
TabIndex = 20
Top = 4800
Width = 1935
End
Begin VB.ComboBox cboSupplier
Height = 315
ItemData = "frmAck.frx":0445
Left = 8760
List = "frmAck.frx":0447
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 19
Top = 5340
Visible = 0 'False
Width = 3075
End
Begin VB.CheckBox chkSeperate
Caption = "Print Each Supplier on Separate Page"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 18
Top = 240
Width = 3615
End
Begin Crystal.CrystalReport CRDaily
Left = 9840
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "&Print"
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 = 10800
TabIndex = 17
Top = 4260
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 = 9780
TabIndex = 16
Top = 4260
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 = 8760
TabIndex = 15
Top = 4260
Width = 915
End
Begin VB.TextBox txtTime
Height = 315
Left = 10080
TabIndex = 3
Top = 3120
Width = 1755
End
Begin VB.TextBox txtSequence
Height = 315
Left = 10080
TabIndex = 5
Top = 3840
Width = 375
End
Begin VB.TextBox txtConfirm
Height = 315
Left = 10080
TabIndex = 4
Top = 3480
Width = 1755
End
Begin VB.TextBox txtODate
Alignment = 1 'Right Justify
Height = 315
Left = 10080
TabIndex = 2
Top = 2400
Width = 1755
End
Begin MSComCtl2.DTPicker dtpODate
Height = 315
Left = 1560
TabIndex = 1
Top = 0
Width = 2115
_ExtentX = 3731
_ExtentY = 556
_Version = 393216
Format = 93519873
CurrentDate = 37138
End
Begin MSComCtl2.DTPicker dtpEODate
Height = 315
Left = 1560
TabIndex = 24
Top = 360
Width = 2115
_ExtentX = 3731
_ExtentY = 556
_Version = 393216
Format = 93519873
CurrentDate = 37138
End
Begin VB.Label lblProcess
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Process Date: "
Height = 195
Left = 8610
TabIndex = 29
Top = 2820
Width = 1485
End
Begin VB.Label lblEndDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Last Drop Date: "
Height = 195
Left = 330
TabIndex = 25
Top = 480
Width = 1170
End
Begin VB.Label lblVWPPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP P.O.:"
Height = 195
Left = 9360
TabIndex = 14
Top = 1740
Width = 780
End
Begin VB.Label lblDTime
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Delivery Time:"
Height = 195
Left = 9000
TabIndex = 13
Top = 3180
Width = 1005
End
Begin VB.Label lblSequence
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Fax Sequence:"
Height = 195
Left = 8940
TabIndex = 12
Top = 3900
Width = 1080
End
Begin VB.Label lblConfirm
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Confirmed By:"
Height = 195
Left = 9060
TabIndex = 11
Top = 3540
Width = 975
End
Begin VB.Label lblOrder
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Drop Date:"
Height = 195
Left = 8850
TabIndex = 10
Top = 2460
Width = 1215
End
Begin VB.Label lblType
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8640
TabIndex = 9
Top = 2040
Width = 3195
End
Begin VB.Label lblPO
BorderStyle = 1 'Fixed Single
Height = 315
Left = 10200
TabIndex = 8
Top = 1680
Width = 1635
End
Begin VB.Label lblProjLot
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8640
TabIndex = 7
Top = 1320
Width = 3195
End
Begin VB.Label lblSupplier
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8640
TabIndex = 6
Top = 960
Width = 3195
End
Begin VB.Label lblODate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "First Drop Date: "
Height = 195
Left = 345
TabIndex = 0
Top = 120
Width = 1155
End
End
Attribute VB_Name = "frmAck"
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, mboolAPRpt As Boolean
Private Sub OrderLoad()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSql2 As String
Dim strTYPE As String, strFLAG As String
Dim strLine As String, lngRET As Long, aTabs(2) As Long
On Error GoTo Error_EH
' aTabs(0) = 25
' aTabs(1) = 120
' aTabs(2) = 200
If chkPrintDate Then
strSQL = "SELECT * from tblOrders WHERE PrintDate >= #" & CDate(dtpODate.Value) & "# and PrintDate <= #" & CDate(dtpEODate.Value) & "#"
Else
strSQL = "SELECT * from tblOrders WHERE Order_Date >= #" & CDate(dtpODate.Value) & "# and Order_Date <= #" & CDate(dtpEODate.Value) & "#"
End If
' strSQL = "SELECT Order_ID, lot_id, Supplier, M_Type, PO_Num from tblOrders WHERE Order_Date = #" & CDate(dtpODate.Value) & "#" ' and Order_Date =< #" & CDate(dtpEODate.Value) & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' lngRET = SendMessage(lstOrders.hwnd, LB_SETTABSTOPS, 3, aTabs(0))
lstOrders.Clear
Do Until oRS.EOF
' If Not (oRS!m_type = "L" Or oRS!m_type = "B" Or oRS!m_type = "S" Or oRS!m_type = "T" Or oRS!m_type = "A") Then
' oRS.MoveNext
' Else
With lstOrders
strSql2 = "SELECT Lot_id, Lot_no FROM tblLotInfo WHERE lot_id = " & oRS!LOT_ID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If oRS!m_type = "L" Then
strTYPE = "LATH "
ElseIf oRS!m_type = "B" Then
strTYPE = "BROWN "
ElseIf oRS!m_type = "S" Then
strTYPE = "SCRATCH "
ElseIf oRS!m_type = "T" Then
strTYPE = "TEXTURE "
ElseIf oRS!m_type = "A" Then
strTYPE = "SAND "
ElseIf oRS!m_type = "P" Then
strTYPE = "PRE-ORDER "
ElseIf oRS!m_type = "W" Then
strTYPE = "WORKORDER/PO "
ElseIf oRS!m_type = "R" Then
strTYPE = "PURCHASE ORDER"
Else
strTYPE = "UNKNOWN"
End If
strLine = ""
strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRS!supplier) & vbTab & Field2Str(oRS!po_num) & vbTab
strLine = strLine & strTYPE & vbTab & Field2Str2(oRS!order_id) & vbTab & Field2Str2(oRS!order_date) & vbTab & Field2Str2(oRS!PrintDate)
.AddItem strLine
' .ItemData(.NewIndex) = oRS!order_id
End With
oRS.MoveNext
' End If
Loop
oRS.Close
If lstOrders.ListCount Then
lstOrders.ListIndex = 0
lstOrders.col = 4
mlngORDERID = lstOrders.ColText
' mlngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
Else
mlngORDERID = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module OrderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderLoadXX()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSql2 As String
Dim strTYPE As String, strFLAG As String
Dim strLine As String, lngRET As Long, aTabs(2) As Long
On Error GoTo Error_EH
aTabs(0) = 25
aTabs(1) = 120
aTabs(2) = 200
strSQL = "SELECT Order_ID, lot_id, Supplier, M_Type, PO_Num from tblOrders WHERE Order_Date = #" & CDate(dtpODate.Value) & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngRET = SendMessage(lstOrders.hwnd, LB_SETTABSTOPS, 3, aTabs(0))
lstOrders.Clear
Do Until oRS.EOF
With lstOrders
strSql2 = "SELECT Lot_id, Lot_no FROM tblLotInfo WHERE lot_id = " & oRS!LOT_ID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If oRS!m_type = "L" Then
strTYPE = "LATH "
ElseIf oRS!m_type = "B" Then
strTYPE = "BROWN "
ElseIf oRS!m_type = "S" Then
strTYPE = "SCRATCH "
ElseIf oRS!m_type = "T" Then
strTYPE = "TEXTURE "
ElseIf oRS!m_type = "A" Then
strTYPE = "SAND "
ElseIf oRS!m_type = "P" Then
strTYPE = "PRE-ORDER "
ElseIf oRS!m_type = "R" Then
strTYPE = "PURCHASE ORDER"
Else
strTYPE = "UNKNOWN"
End If
strLine = ""
strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRS!supplier) & vbTab & Field2Str(oRS!po_num) & vbTab
strLine = strLine & strTYPE ' & vbTab & strFLAG
.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 Ack - Module OrderLoadx"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub chkAPRpt_Click()
If chkAPRpt = vbChecked Then
mboolAPRpt = True
End If
If chkAPRpt = vbUnchecked Then
mboolAPRpt = False
End If
End Sub
Private Sub chkPrint_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdSave.Enabled = True
End Sub
Private Sub chkPrintDate_Click()
Call OrderLoad
End Sub
Private Sub cmdDeliver_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.print} and {tblorders.order_date} = date (" & strYEAR & "," & strMONTH & "," & strDAY & ")" '"
'{tblORDERS.ORDER_DATE} = Date (2001,09,06)
' If chkSeperate Then
' CRDaily.Formulas(0) = "flag = 1"
' End If
CRDaily.ReportFileName = App.Path & "\DeliverySheet.rpt"
CRDaily.ReplaceSelectionFormula (strSQL)
CRDaily.CopiesToPrinter = gintCOPY
CRDaily.Destination = gintDEST
CRDaily.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
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
Dim strEMonth As String, strEYear As String, strEDay As String
On Error GoTo Error_EH
strMONTH = Format(Month(dtpODate.Value), "00")
strDAY = Format(Day(dtpODate.Value), "00")
strYEAR = Year(dtpODate.Value)
strEMonth = Format(Month(dtpEODate.Value), "00")
strEDay = Format(Day(dtpEODate.Value), "00")
strEYear = Year(dtpEODate.Value)
gintPRINT = 1
frmReport.Show 1
If chkAPRpt = vbChecked Then
mboolAPRpt = True
End If
If chkAPRpt = vbUnchecked Then
mboolAPRpt = False
End If
If chkSingle Then
strSQL = "{tblorders.order_date} >= date (" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblorders.order_date} <= date (" & strEYear & "," & strEMonth & "," & strEDay & ")" '"
strSQL = strSQL & " and {tblORDERS.SUPPLIER}= '" & lblSupplier & "'and {tblORDERS.SEQ} = " & txtSequence
' strSQL = "{tblorders.order_date} = date (" & strYEAR & "," & strMONTH & "," & strDAY & ")" '"
' strSQL = strSQL & " and {tblORDERS.SUPPLIER}= '" & lblSupplier & "'and {tblORDERS.SEQ} = " & txtSequence
ElseIf chkPrtLBOnly And chkPrintDate Then
strSQL = "{tblorders.PrintDate} >= date (" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblorders.PrintDate} <= date (" & strEYear & "," & strEMonth & "," & strEDay & ")" '"
strSQL = strSQL & " and ({tblORDERS.m_type}= 'L' or {tblORDERS.m_type}= 'B')" ' or {tblORDERS.m_type}= 'S' or {tblORDERS.m_type}= 'A' or {tblORDERS.m_type}= 'T')" ' = " & txtSequence
' strSQL = strSQL & " and ({tblORDERS.m_type}= 'L' or {tblORDERS.m_type}= 'B' or {tblORDERS.m_type}= 'S' or {tblORDERS.m_type}= 'A' or {tblORDERS.m_type}= 'T')" ' = " & txtSequence
ElseIf chkPrtLBOnly Then
strSQL = "{tblorders.order_date} >= date (" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblorders.order_date} <= date (" & strEYear & "," & strEMonth & "," & strEDay & ")" '"
strSQL = strSQL & " and ({tblORDERS.m_type}= 'L' or {tblORDERS.m_type}= 'B')" ' or {tblORDERS.m_type}= 'S' or {tblORDERS.m_type}= 'A' or {tblORDERS.m_type}= 'T')" ' = " & txtSequence
' strSQL = strSQL & " and ({tblORDERS.m_type}= 'L' or {tblORDERS.m_type}= 'B' or {tblORDERS.m_type}= 'S' or {tblORDERS.m_type}= 'A' or {tblORDERS.m_type}= 'T')" ' = " & txtSequence
ElseIf chkAPRpt Then
strSQL = "{tblorders.order_date} >= date (" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblorders.order_date} <= date (" & strEYear & "," & strEMonth & "," & strEDay & ")" '"
Else
strSQL = "{tblorders.order_date} >= date (" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblorders.order_date} <= date (" & strEYear & "," & strEMonth & "," & strEDay & ")" '"
' strSQL = strSQL & " and ({tblORDERS.m_type}= 'L' or {tblORDERS.m_type}= 'B' or {tblORDERS.m_type}= 'S' or {tblORDERS.m_type}= 'A' or {tblORDERS.m_type}= 'T')" ' = " & txtSequence
' strSQL = strSQL & " and not ({tblORDERS.m_type}= 'P' or {tblORDERS.m_type}= 'R')" ' = " & txtSequence
' strSQL = "{tblorders.order_date} = date (" & strYEAR & "," & strMONTH & "," & strDAY & ")" '"
End If
'{tblORDERS.ORDER_DATE} = Date (2001,09,06)
If chkSeperate Then
CRDaily.Formulas(0) = "flag = 1"
End If
If mboolAPRpt Then
CRDaily.ReportFileName = App.Path & "\Dailyorders2.rpt"
ElseIf Not mboolAPRpt Then
CRDaily.ReportFileName = App.Path & "\Dailyorders.rpt"
End If
CRDaily.ReplaceSelectionFormula (strSQL)
CRDaily.CopiesToPrinter = gintCOPY
CRDaily.Destination = gintDEST
CRDaily.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstOrders.ListIndex
Call FormSave
cboSupplier.Visible = False
cmdSave.Enabled = False
lstOrders.Enabled = True
lstOrders.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
End Sub
Private Sub cmdUpdate_Click()
cboSupplier.Visible = True
If IsNull(moRSORDER!supplier) Then
cboSupplier.ListIndex = -1
Else
Call CBFindString(cboSupplier, Field2Str(moRSORDER!supplier))
End If
End Sub
Private Sub dtpEODate_Change()
If dtpEODate.Value < dtpODate.Value Then
MsgBox "Last Date Connot Be Less Than The First Date", vbOKOnly, "ReEnter Date"
dtpEODate.SetFocus
Exit Sub
End If
Call OrderLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End Sub
Private Sub dtpODate_Change()
Call OrderLoad
If FormFind() Then
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
dtpEODate.Value = Date
Call OrderLoad
Call SupplierLoad
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - 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 Ack - 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
mboolAPRpt = False
lblProjLot.Caption = ""
lblSupplier.Caption = ""
lblType.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)
txtProcess = Field2Str(!PrintDate)
txtConfirm = Field2Str(!confirmed)
txtSequence = Field2Str(!seq)
txtTime = Field2Str(!del_time)
chkPrint = Field2CheckBox(!Print)
If Field2Str(!m_type) = "L" Then
lblType.Caption = "LATH "
ElseIf Field2Str(!m_type) = "B" Then
lblType.Caption = "BROWN "
ElseIf Field2Str(!m_type) = "S" Then
lblType.Caption = "SCRATCH "
ElseIf Field2Str(!m_type) = "T" Then
lblType.Caption = "TEXTURE "
ElseIf Field2Str(!m_type) = "A" Then
lblType.Caption = "SAND "
ElseIf Field2Str(!m_type) = "P" Then
lblType.Caption = "PRE-ORDER "
ElseIf Field2Str(!m_type) = "R" Then
lblType.Caption = "PURCHASE ORDER"
Else
lblType.Caption = ""
End If
lblSupplier.Caption = Field2Str(!supplier)
lblPO.Caption = Field2Str(!ponum)
End With
' Call GetLotInfo
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strLOT As String
On Error GoTo Error_EH
With moRSORDER
!order_date = Str2Field(txtODate)
!del_time = Str2Field(txtTime)
!confirmed = Str2Field(txtConfirm)
!seq = Str2Field(txtSequence)
!Print = chkPrint
End With
If cboSupplier.Visible Then
moRSORDER!supplier = cboSupplier.Text
End If
moRSORDER.Update
If FormFind() Then
Call FormShow 'xxxxxxxxxxxxxxxxxx
Else
Call FormClear
End If
' End If
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
Resume Next
End If
gstrMODULE = "Form Ack - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtODate = ""
txtTime = ""
txtSequence = ""
txtConfirm = ""
lblSupplier.Caption = ""
lblType.Caption = ""
lblPO.Caption = ""
lblProjLot.Caption = ""
chkPrint = vbUnchecked
chkSeperate = vbUnchecked
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSave
moRSORDER.Update
Call OrderLoad
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - 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
End Sub
Private Sub lstOrders_Click()
On Error GoTo Error_EH
If lstOrders.ListIndex <> -1 Then
lstOrders.col = 4
mlngORDERID = lstOrders.ColText
' mlngORDERID = lstOrders.ItemData(lstOrders.ListIndex)
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module lstOrders_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstOrders_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub txtConfirm_GotFocus()
Call FieldSelect(txtConfirm)
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 txtConfirm_LostFocus()
txtConfirm = UCase(txtConfirm)
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
Do Until moRS.EOF
strLine = ""
strLine = Field2Str(moRS!lot_no) & vbTab & Field2Str(moRS!address)
moRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - 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
Do Until oRS.EOF
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module ProjectSelect"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub txtSequence_GotFocus()
Call FieldSelect(txtConfirm)
End Sub
Private Sub txtTime_GotFocus()
Call FieldSelect(txtODate)
End Sub
Private Sub txtTime_LostFocus()
txtTime = UCase(txtTime)
End Sub
Private Sub SupplierLoad()
Dim oRS As Recordset
Dim strSQL As String, strFLAG As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblSupplier" ' where type = '" & strFLAG & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
If oRS!Type <> "S" Then
cboSupplier.AddItem oRS!supplier
cboSupplier.ItemData(cboSupplier.NewIndex) = Field2Long(oRS!sup_no)
End If
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Ack - Module SupplierLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Reference in New Issue View Git Blame Copy Permalink