Mike Swanson
5359e7c49e
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>
127 lines
6.0 KiB
Plaintext
127 lines
6.0 KiB
Plaintext
Private Sub LoadInventory()
|
|
Dim oSTATUS As Long
|
|
Dim strSQL As String, strSQLL As String, dblONHAND As Double
|
|
Dim strLine As String, strCode As String, strCompany As String
|
|
Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String
|
|
Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long
|
|
Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long
|
|
Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long
|
|
Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double
|
|
Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double
|
|
Dim lngBUYCON As Long, dblBUYCON As Double
|
|
Dim lngWEIGHT As Long, dblWEIGHT As Double
|
|
Dim lngONORDER As Long, dblONORDER As Double
|
|
Dim lngCSQty As Long, strCSQty As String
|
|
Dim intYN As Integer, strMSG As String
|
|
Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long
|
|
Dim strLOrder As String, strLPur As String, strLSALE As String, strTStock As String
|
|
Dim strWeight As String, intMIN As Integer, strFIND As String, strTVend As String
|
|
Dim strVSTOCK As String, lngVSTOCK As Long, lngIMAGE As Long, strIMAGE As String
|
|
|
|
'TAG4 pointers
|
|
Dim lngCustTag As Long
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
strSQL = gstrCOMPANY & "INMAS"
|
|
db = d4open(cb, fPath + strSQL)
|
|
|
|
rc = d4top(db)
|
|
|
|
lstInventory.Clear
|
|
lstInventory.SortState = SortStateSuspend
|
|
If d4top(db) = r4success Then
|
|
|
|
Do
|
|
oSTATUS = d4deleted(db)
|
|
If oSTATUS = 0 Then
|
|
lngCUST = d4field(db, "IN_DES")
|
|
strCUST = f4str(lngCUST)
|
|
If IsNull(strCUST) Or IsNull(txtSearch) Or txtSearch = "" Then
|
|
intYN = 0
|
|
Else
|
|
intYN = InStr(1, UCase(Trim(strCUST)), UCase(Trim(txtSearch))) ', vbTextCompare)
|
|
End If
|
|
If intYN > 0 Then
|
|
With lstInventory
|
|
lngNAME = d4field(db, "IN_STOCK")
|
|
' lngCUST = d4field(db, "IN_DES")
|
|
lngVEND = d4field(db, "IN_VENDOR")
|
|
lngType = d4field(db, "IN_TYPE")
|
|
lngONHAND = d4field(db, "IN_ONHAND")
|
|
lngMIN = d4field(db, "IN_MINQTY")
|
|
lngMAX = d4field(db, "IN_MAXQTY")
|
|
lngCOMMIT = d4field(db, "IN_COMMIT")
|
|
lngLSTCOST = d4field(db, "IN_LSCOST")
|
|
lngRETAIL1 = d4field(db, "IN_PRICE1")
|
|
lngBUYCON = d4field(db, "IN_ALTRN1")
|
|
lngONORDER = d4field(db, "IN_ORDERTE")
|
|
lngWEIGHT = d4field(db, "IN_FIELD07")
|
|
lngCSQty = d4field(db, "IN_FIELD08")
|
|
lngLOrder = d4field(db, "IN_LSORDR")
|
|
lngLPur = d4field(db, "IN_LSPRCH")
|
|
lngLSALE = d4field(db, "IN_LSSALE")
|
|
lngVSTOCK = d4field(db, "IN_FIELD10")
|
|
lngIMAGE = d4field(db, "IN_GRAPHIC")
|
|
strTYPE = f4str(lngType)
|
|
strNAME = f4str(lngNAME)
|
|
' strCUST = f4str(lngCUST)
|
|
strVEND = f4str(lngVEND)
|
|
strVSTOCK = Trim(f4str(lngVSTOCK))
|
|
dblONHAND = f4double(lngONHAND)
|
|
dblMIN = f4double(lngMIN)
|
|
dblMAX = f4double(lngMAX)
|
|
dblCOMMIT = f4double(lngCOMMIT)
|
|
dblAVAIL = dblONHAND - dblCOMMIT
|
|
dblLSTCOST = f4double(lngLSTCOST)
|
|
dblRETAIL1 = f4double(lngRETAIL1)
|
|
dblBUYCON = f4double(lngBUYCON)
|
|
dblONORDER = f4double(lngONORDER)
|
|
dblWEIGHT = f4double(lngWEIGHT)
|
|
strWeight = dblWEIGHT
|
|
strCSQty = f4str(lngCSQty)
|
|
If Trim(strCSQty) = "0.00" Then
|
|
strCSQty = ""
|
|
End If
|
|
strLOrder = f4str(lngLOrder)
|
|
strLPur = f4str(lngLPur)
|
|
strLSALE = f4str(lngLSALE)
|
|
strIMAGE = f4str(lngIMAGE)
|
|
' If Trim(strCSQty) = "0.00" Then
|
|
' strCSQty = ""
|
|
' End If
|
|
If Trim(strWeight) = "0.00" Or Trim(strWeight) = "0" Then
|
|
strWeight = ""
|
|
End If
|
|
' .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) & vbTab & Trim$(strVEND) & vbTab & Trim$(strTYPE) & vbTab & (dblMIN) & vbTab & (dblMAX) & vbTab & (dblAVAIL) & vbTab & (dblLSTCOST) & vbTab & (dblRETAIL1) & vbTab & dblBUYCON & vbTab & dblONORDER & vbTab & dblWEIGHT & vbTab & strCSQty
|
|
' .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) & vbTab & Trim$(strVEND) & vbTab & Trim$(strTYPE) & vbTab & (dblMIN) & vbTab & (dblMAX) & vbTab & (dblAVAIL) & vbTab & (dblLSTCOST) & vbTab & (dblRETAIL1) & vbTab & dblBUYCON & vbTab & dblONORDER & vbTab & dblWEIGHT & vbTab & strCSQty & vbTab & strLOrder & vbTab & strLPur & vbTab & strLSALE & vbTab & (strVSTOCK) & vbTab & (strIMAGE)
|
|
.AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) & vbTab & Trim$(strVEND) & vbTab & Trim$(strTYPE) & vbTab & (dblMIN) & vbTab & (dblMAX) & vbTab & (dblAVAIL) & vbTab & (dblLSTCOST) & vbTab & (dblRETAIL1) & vbTab & dblBUYCON & vbTab & dblONORDER & vbTab & strWeight & vbTab & strCSQty & vbTab & strLOrder & vbTab & strLPur & vbTab & strLSALE & vbTab & (strVSTOCK) & vbTab & (strIMAGE) & vbTab & (strONHAND)
|
|
End With
|
|
End If
|
|
End If
|
|
rc = d4skip(db, 1)
|
|
Loop While rc = r4success
|
|
End If
|
|
|
|
|
|
rc = d4close(db)
|
|
|
|
If lstInventory.ListCount Then
|
|
lstInventory.ListIndex = 0
|
|
Else
|
|
' MsgBox "No Inventory Items Were Found Matching The", vbInformation + vbOKOnly, "No Customers"
|
|
strMSG = "No Inventory Items Were Found Matching The"
|
|
strMSG = strMSG & vbCrLf & " Information You Entered"
|
|
MsgBox strMSG, vbInformation + vbOKOnly, "Nothing Matches"
|
|
End If
|
|
lstInventory.SortState = SortStateActiveReSort
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PO - Module LoadInventory"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|