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

885 lines
26 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 frmPosPayV
Caption = "Valley Wide PosPay Info"
ClientHeight = 4365
ClientLeft = 60
ClientTop = 345
ClientWidth = 6990
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4365
ScaleWidth = 6990
StartUpPosition = 3 'Windows Default
Begin MSComCtl2.DTPicker dtStart
Height = 300
Left = 2730
TabIndex = 23
Top = 4065
Width = 1230
_ExtentX = 2170
_ExtentY = 529
_Version = 393216
Format = 41222145
CurrentDate = 43425
End
Begin VB.CommandButton cmdPrint2
Caption = "Print List W/ Name"
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 = 4260
TabIndex = 22
Top = 3675
Width = 1275
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
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 = 4260
TabIndex = 21
Top = 3090
Width = 1275
End
Begin VB.CommandButton cmdAdd
Caption = "Add"
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 = 5595
TabIndex = 20
Top = 2505
Width = 1275
End
Begin VB.TextBox txtInvDate
Enabled = 0 'False
Height = 315
Left = 5685
MaxLength = 10
TabIndex = 1
Top = 15
Width = 1200
End
Begin VB.TextBox txtUser
Enabled = 0 'False
Height = 315
Left = 5685
TabIndex = 18
Top = 2145
Width = 1200
End
Begin VB.TextBox txtSeq
Alignment = 2 'Center
Enabled = 0 'False
Height = 315
Left = 5685
TabIndex = 17
Top = 1785
Width = 1200
End
Begin VB.TextBox txtSubDt
Enabled = 0 'False
Height = 315
Left = 5685
TabIndex = 16
Top = 1440
Width = 1200
End
Begin VB.TextBox txtSearch
Height = 315
Left = 3015
TabIndex = 12
Top = 150
Width = 1200
End
Begin VB.CommandButton cmdPrint
Caption = "Print List For 1 Seq #"
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 = 4260
TabIndex = 11
Top = 2505
Width = 1275
End
Begin LpLib.fpList lstHeader
Height = 3480
Left = 180
TabIndex = 10
Top = 585
Width = 4035
_Version = 196608
_ExtentX = 7117
_ExtentY = 6138
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 = 6
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = 1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 2
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 = "frmPosPayV.frx":0000
End
Begin Crystal.CrystalReport crAR
Left = 165
Top = 60
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
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 = 5610
TabIndex = 9
Top = 3675
Width = 1275
End
Begin VB.CommandButton cmdSave
Caption = "Save"
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 = 5595
TabIndex = 4
Top = 3075
Width = 1275
End
Begin VB.TextBox txtItemAmt
Alignment = 2 'Center
Enabled = 0 'False
Height = 315
Left = 5685
MaxLength = 10
TabIndex = 5
Top = 1080
Width = 1200
End
Begin VB.TextBox txtSalesCode
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 5685
MaxLength = 13
TabIndex = 3
Top = 735
Width = 1200
End
Begin VB.TextBox txtDueDate
Enabled = 0 'False
Height = 315
Left = 5685
MaxLength = 10
TabIndex = 2
Top = 375
Width = 1200
End
Begin VB.Label lblLOAD
Alignment = 2 'Center
BackColor = &H0080FFFF&
Caption = "LOADING"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 90
TabIndex = 25
Top = 4140
Visible = 0 'False
Width = 1275
End
Begin VB.Label lblStart
Alignment = 1 'Right Justify
Caption = "Starting Date:"
Height = 255
Left = 1530
TabIndex = 24
Top = 4110
Width = 1155
End
Begin VB.Label lblInvDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check Number: "
Height = 195
Left = 4410
TabIndex = 19
Top = 90
Width = 1155
End
Begin VB.Label lblUser
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "User:"
Height = 195
Left = 5190
TabIndex = 15
Top = 2205
Width = 375
End
Begin VB.Label lblSubDt
AutoSize = -1 'True
Caption = "Date Submitted:"
Height = 195
Left = 4425
TabIndex = 14
Top = 1500
Width = 1140
End
Begin VB.Label lblSeq
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sequence #:"
Height = 195
Left = 4635
TabIndex = 13
Top = 1845
Width = 930
End
Begin VB.Label lblSalesCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check Amount: "
Height = 195
Left = 4425
TabIndex = 8
Top = 795
Width = 1140
End
Begin VB.Label lblItemAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMS Bank #"
Height = 195
Left = 4650
TabIndex = 7
Top = 1140
Width = 915
End
Begin VB.Label lblDueDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check Date: "
Height = 195
Left = 4620
TabIndex = 6
Top = 435
Width = 945
End
Begin VB.Label lblARCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Enter Check Number To Search:"
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 = 150
TabIndex = 0
Top = 180
Width = 2775
End
End
Attribute VB_Name = "frmPosPayV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSHeader As Recordset
Dim moRSProj As Recordset
Dim mboolSHOW As Boolean, mboolUPDATE As Boolean, mstrType As String
Dim mstrINVNO As String, mstrPROJLOT As String
Dim mlngINVID As Long, mintBOOKMARK As Integer, mintBOOK As Integer
Dim msglItemAmt As Single, msglInvTotal As Single
Private Sub HeaderLoad()
Dim oRS As Recordset
Dim strSQL As String, strVend As String
'Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
lblLOAD.Visible = True
DoEvents
' strTYPE = Trim(Left(cboARCode, 7))
' strSQL = "SELECT Invoice_date, Invoice_no, lot_id, trans_id, header, shipped, customer_no, non_tax_amt from tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
' If cboAPCode.ListIndex = -1 Then
strSQL = "SELECT * FROM tblPosPayVWP WHERE CKDate >= #" & dtStart.Value & "# ORDER BY CKDate DESC " ' and not done"
' Else
' cboAPCode.col = 1
' strVend = cboAPCode.ColText
' strSQL = "SELECT * FROM APH_JobDistDetail ORDER BY VendorNumber and InvoiceNumber" 'WHERE shipped and header and customer_no = '" & strVend & "' and not done"
' strSQL = "SELECT * FROM APH_JobDistDetail WHERE vendornumber = '" & strVend & "'" ' and not done"
' End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHeader.Clear
' strTYPE = oRS.RecordCount
Do Until oRS.EOF
With lstHeader
'' strLine = Field2Str2(oRS!PPID) & vbTab & Field2Str(oRS!CKNumber) & vbTab & " " & Trim(Field2Str(oRS!Name)) & vbTab & Format(Field2Str(oRS!CKDate), "MM/DD/YYYY") & vbTab
'' strLine = strLine & Format(Field2Str(oRS!CKAmt), "#,#.00") & vbTab & Field2Str(oRS!Acct) & vbTab & Field2Str(oRS!sequence)
strLine = Field2Str2(oRS!PPID) & vbTab & Field2Str(oRS!CKNumber) & vbTab & Format(Field2Str(oRS!CKDate), "MM/DD/YYYY") & vbTab
strLine = strLine & Format(Field2Str(oRS!CKAmt), "#,#.00") & vbTab & Field2Str(oRS!Acct) & vbTab & Field2Str(oRS!sequence)
' strLine = strLine & Format(Field2Str2(oRS!distributionamount), "Currency") ' & " " & Format(Field2Str2(oRS!Lot_id), "000000")
.AddItem strLine
' .ItemData(.NewIndex) = oRS!Trans_ID
' .ItemData(.NewIndex) = oRS!Lot_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstHeader.ListCount Then
lstHeader.ListIndex = 0
Else
gintLOTID = 0
lstHeader.ListIndex = -1
' cmdPrint.Enabled = False
End If
lblLOAD.Visible = False
DoEvents
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module HeaderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Dim oRS As Recordset, strSQL As String, strSELECT As String, strCUST As String
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "SELECT * FROM APH_JobDistDetail WHERE VendorNumber = '" & strCUST & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' strSELECT = "{APH_JobDistDetail.VendorNumber}= '" & strCUST & "' and {APH_JobDistDetail.JobNumber} = ''"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crAR.ReportFileName = App.Path & "\PosPayNEW.rpt"
' crAR.ReplaceSelectionFormula (strSELECT)
' crAR.CopiesToPrinter = gintCOPY
crAR.CopiesToPrinter = 1
crAR.Destination = crptToWindow
' crar.Destination = crptToPrinter
crAR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form ARFix - Module Print"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint2_Click()
Dim oRS As Recordset, strSQL As String, strSELECT As String, strCUST As String
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "SELECT * FROM APH_JobDistDetail WHERE VendorNumber = '" & strCUST & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' strSELECT = "{APH_JobDistDetail.VendorNumber}= '" & strCUST & "' and {APH_JobDistDetail.JobNumber} = ''"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crAR.ReportFileName = App.Path & "\PosPayVW.rpt"
' crAR.ReplaceSelectionFormula (strSELECT)
' crAR.CopiesToPrinter = gintCOPY
crAR.CopiesToPrinter = 1
crAR.Destination = crptToWindow
' crar.Destination = crptToPrinter
crAR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form PosPayV - Module Print2"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub dtStart_CloseUp()
Call HeaderLoad
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSave.Enabled Then
' Call DataHasChanged
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSave.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
If moRSProj.State = adStateOpen Then
moRSProj.Close
End If
If moRSHeader.State = adStateOpen Then
moRSHeader.Close
End If
Exit Sub
Error_EH:
If Err.Number = 91 Then
Resume Next
End If
gstrMODULE = "Form Repair - Module Form QueryUnload"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOK = lstHeader.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
cmdDelete.Enabled = False
Call FormSave
lstHeader.ListIndex = mintBOOK
cmdDelete.Enabled = False
cmdAdd.Enabled = True
cmdSave.Enabled = False
lstHeader.Enabled = True
End Sub
Private Sub Form_Load()
' dtStart.Value = Date - 60
dtStart.Value = Date - 30
Call HeaderLoad
If gbytSECURITY < 3 Then
cmdPrint2.Enabled = True
End If
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
' With moRSDetail
txtInvDate = Field2Str(moRSHeader!CKNumber)
txtDueDate = Field2Str(moRSHeader!CKDate)
txtSalesCode = Format(Field2Str2(moRSHeader!CKAmt), "#,#,#.00")
txtItemAmt = Field2Str(moRSHeader!Acct)
txtSubDt = Field2Str(moRSHeader!SubDate)
txtSeq = Field2Str(moRSHeader!sequence)
txtUser = Field2Str(moRSHeader!User)
' End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form PosPayV - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAdd_Click()
' mboolbookmark = lstEmpList.ListIndex
txtInvDate.Enabled = True
txtDueDate.Enabled = True
txtSalesCode.Enabled = True
lstHeader.Enabled = False
cmdAdd.Enabled = False
cmdDelete.Enabled = False
cmdSave.Enabled = True
Call FormClear
' txtDept.SetFocus
' lstEmpList.ListIndex = mintBOOKMARK
End Sub
Private Sub cmdDelete_Click()
Dim strYN As String, lngBOOKMARK As Long
If moRSHeader!Submit Then
MsgBox "You Cannot Delete A Check That Has Been Submitted", vbOKOnly, "Delete Not Allowed"
cmdDelete.Enabled = False
cmdAdd.Enabled = True
cmdSave.Enabled = False
Exit Sub
End If
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
lngBOOKMARK = lstHeader.ListIndex
moRSHeader.Delete
Call HeaderLoad
If lstHeader.ListCount > 0 Then
If lstHeader.ListCount > lngBOOKMARK Then
lstHeader.ListIndex = lngBOOKMARK
lngBOOKMARK = 0
Else
lstHeader.ListIndex = lngBOOKMARK - 1
End If
End If
cmdDelete.Enabled = False
cmdAdd.Enabled = True
cmdSave.Enabled = False
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
Exit Sub
Error_EH:
gstrMODULE = "Form PosPayV - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, lngID As Long
On Error GoTo Error_EH
lstHeader.col = 0
lngID = CLng(lstHeader.ColText)
strSQL = "SELECT * FROM tblPosPayVWP WHERE PPid = " & lngID 'lstDetail.ItemData(lstDetail.ListIndex)
Set moRSHeader = New Recordset
moRSHeader.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSHeader.EOF Then
FormFind = False
Call FormClear
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form PosPayV - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub lstHeader_Click()
' If lstDetail.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
End If
' End If
End Sub
Private Sub FieldsSave()
Dim strSQL As String
Dim oRS As Recordset, sglTOTAL As Single
On Error GoTo Error_EH
With moRSHeader
.AddNew
!CKNumber = Str2Field(txtInvDate)
!CKDate = Str2Field(txtDueDate)
' !price = Str2Field(txtItemAmt)
!Acct = "8"
!CKAmt = Format(Str2Field(txtSalesCode), "0000000.00")
!Submit = False
.Update
End With
Call HeaderLoad
Exit Sub
Error_EH:
gstrMODULE = "Form PosPayV - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtInvDate = ""
txtDueDate = ""
txtSalesCode = ""
txtItemAmt = ""
txtSubDt = ""
txtSeq = ""
txtUser = ""
End Sub
Private Sub lstHeader_DblClick()
cmdDelete.Enabled = True
cmdAdd.Enabled = False
End Sub
Private Sub txtDueDate_GotFocus()
Call FieldSelect(txtDueDate)
End Sub
Private Sub txtDueDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtDueDate, "/", 1)
If lngPOS = 0 Then
If Len(txtDueDate) > 0 Then
txtDueDate = Format(txtDueDate, "00/00/####")
If Not IsDate(txtDueDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtDueDate.SetFocus
End If
End If
ElseIf IsDate(txtDueDate) Then
Exit Sub
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtDueDate.SetFocus
End If
' txtDueDate = UCase(txtDueDate)
End Sub
Private Sub txtInvDate_GotFocus()
Call FieldSelect(txtInvDate)
End Sub
Private Sub txtSalesCode_GotFocus()
Call FieldSelect(txtSalesCode)
End Sub
Private Sub txtSalesCode_LostFocus()
Dim intLEN As Integer, strMSG As String
txtSalesCode = Format((txtSalesCode), "0000000.00")
intLEN = Len(txtSalesCode)
If intLEN > 10 Then
strMSG = "Number Must 10 Digits Or Less Including The '.'"
strMSG = strMSG & vbCrLf & vbCrLf & "ReEnter as #######.##"
' msgbox (strmsg,vbOKOnly,"ReEnter The Amount")
MsgBox strMSG, vbOKOnly, "ReEnter The Amount"
txtSalesCode = ""
txtSalesCode.SetFocus
End If
End Sub
Private Sub txtSearch_Change()
'Multiple character search code.
lstHeader.ColumnSearch = 1
lstHeader.SearchText = txtSearch.Text
lstHeader.SearchMethod = SearchMethodExactMatch
lstHeader.Action = ActionSearch
' lstHeader.SearchIndex = -1
If lstHeader.SearchIndex <> -1 Then
lstHeader.TopIndex = lstHeader.SearchIndex
lstHeader.ListIndex = lstHeader.SearchIndex
Else
lstHeader.Action = 6 ' clear
End If
End Sub
Private Sub txtSearch_LostFocus()
txtSearch = ""
End Sub
Reference in New Issue View Git Blame Copy Permalink