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_Current/frmARFix.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

999 lines
30 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmARFIX
Caption = "Accounts Receivable Correction Screen"
ClientHeight = 5310
ClientLeft = 60
ClientTop = 345
ClientWidth = 8880
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5310
ScaleWidth = 8880
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox cboSort
Height = 315
ItemData = "frmARFix.frx":0000
Left = 7035
List = "frmARFix.frx":000A
Style = 2 'Dropdown List
TabIndex = 17
Top = 2505
Width = 1845
End
Begin VB.CommandButton cmdPrint
Caption = "Print List Of Blank JC#"
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 = 6120
TabIndex = 16
Top = 4220
Width = 1275
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 315
Left = 7665
TabIndex = 15
Top = 1425
Width = 465
End
Begin LpLib.fpCombo cboARCode
Height = 315
Left = 4815
TabIndex = 12
Top = 150
Width = 4035
_Version = 196608
_ExtentX = 7117
_ExtentY = 556
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 = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
Columns = 3
Sorted = 0
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
WrapList = 0 'False
WrapWidth = 0
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
DataFieldList = ""
ColumnEdit = -1
ColumnBound = -1
Style = 2
MaxDrop = 8
ListWidth = -1
EditHeight = -1
GrayAreaColor = -2147483633
ListLeftOffset = 0
ComboGap = -2
MaxEditLen = 150
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
EnableClickEvent= -1 'True
ListPosition = 0
ButtonThreeDAppearance= 0
OLEDragMode = 0
OLEDropMode = 0
Redraw = -1 'True
AutoSearchFill = 0 'False
AutoSearchFillDelay= 500
EditMarginLeft = 1
EditMarginTop = 1
EditMarginRight = 0
EditMarginBottom= 3
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
AutoMenu = -1 'True
EditAlignH = 0
EditAlignV = 0
ColDesigner = "frmARFix.frx":001D
End
Begin LpLib.fpList lstHeader
Height = 4260
Left = 60
TabIndex = 11
Top = 600
Width = 6000
_Version = 196608
_ExtentX = 10583
_ExtentY = 7514
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 = 9
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = 2
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 = "frmARFix.frx":041D
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 = 6120
TabIndex = 10
Top = 4755
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 = 7590
TabIndex = 3
Top = 4755
Width = 1275
End
Begin VB.TextBox txtItemAmt
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 7665
MaxLength = 10
TabIndex = 5
Top = 1065
Width = 1200
End
Begin VB.TextBox txtSalesCode
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 7665
MaxLength = 7
TabIndex = 4
Top = 2145
Width = 1200
End
Begin VB.TextBox txtDueDate
Height = 315
Left = 7665
MaxLength = 7
TabIndex = 2
Top = 1785
Width = 1200
End
Begin VB.TextBox txtInvDate
Enabled = 0 'False
Height = 315
Left = 7665
MaxLength = 10
TabIndex = 1
Top = 720
Width = 1200
End
Begin VB.Label lblSort
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sort By:"
Height = 195
Left = 6420
TabIndex = 18
Top = 2565
Width = 555
End
Begin VB.Label lblInvType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Type:"
Height = 195
Left = 6480
TabIndex = 14
Top = 1545
Width = 975
End
Begin VB.Label lblLOAD
Alignment = 2 'Center
BackColor = &H00C0FFFF&
Caption = "Loading Invoices -- Patience"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 750
Left = 6105
TabIndex = 13
Top = 3420
Visible = 0 'False
Width = 2745
End
Begin VB.Label lblSalesCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Amount:"
Height = 195
Left = 6390
TabIndex = 9
Top = 2235
Width = 1155
End
Begin VB.Label lblItemAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Sequence:"
Height = 195
Left = 6195
TabIndex = 8
Top = 1170
Width = 1350
End
Begin VB.Label lblDueDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Job Cost Number:"
Height = 195
Left = 6285
TabIndex = 7
Top = 1890
Width = 1260
End
Begin VB.Label lblInvDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice #:"
Height = 195
Left = 6825
TabIndex = 6
Top = 810
Width = 720
End
Begin VB.Label lblARCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Builders's CMS AR Code:"
Height = 195
Left = 3000
TabIndex = 0
Top = 240
Width = 1785
End
End
Attribute VB_Name = "frmARFIX"
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, strAMOUNT As String
'Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
' 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"
lblLOAD.Visible = True
DoEvents
If cboARCode.ListIndex = -1 Then
strSQL = "SELECT * FROM ARN_InvHistoryHeader " 'WHERE vendornumber = '" & strVend & "'" ' and not done"
Else
cboARCode.col = 1
strVend = cboARCode.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 ARN_InvHistoryHeader WHERE customernumber = '" & 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
If Field2Str2(oRS!TaxableSalesAmount) >= 0 Then
strAMOUNT = Field2Str2(oRS!NonTaxableSalesAmount)
Else
strAMOUNT = Field2Str2(oRS!TaxableSalesAmount)
End If
strLine = Field2Str2(oRS!AR_ID) & vbTab & Field2Str(oRS!CustomerNumber) & vbTab '& Field2Str(oRS!Name) & vbTab
strLine = strLine & Field2Str(oRS!InvoiceNumber) & vbTab & Field2Str(oRS!seqnumber) & vbTab & Field2Str(oRS!InvoiceType) & vbTab
strLine = strLine & Field2Str(oRS!InvoiceDate) & vbTab & Field2Str(oRS!JobNumber) & vbTab & Format(strAMOUNT, "Currency") & vbTab & Format(Field2Str(oRS!InvoiceDate), "YYYYMMDD")
.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
cboSort.ListIndex = 0
Exit Sub
Error_EH:
gstrMODULE = "Form ARFix - Module HeaderLoad"
Call ErrorHandler2
gstrMODULE = ""
lblLOAD.Visible = False
Exit Sub
End Sub
Private Sub cboARCode_Click()
lstHeader.Clear
Call HeaderLoad
End Sub
Private Sub cboSort_Change()
If cboSort.ListIndex = 0 Then
lstHeader.col = 2
lstHeader.ColSortDataType = ColSortDataTypeTextNoCase
lstHeader.ColSorted = SortedDescending
lstHeader.Sorted = SortedDescending
' lstHeader.Sorted
ElseIf cboSort.ListIndex = 1 Then
lstHeader.col = 5
lstHeader.ColSorted = SortedDescending
End If
End Sub
Private Sub cboSort_Click()
If cboSort.ListIndex = 0 Then
lstHeader.col = 8
' lstHeader.ColSortDataType = ColSortDataTypeDate
lstHeader.ColSortSeq = -1
lstHeader.ColSorted = SortedNone
lstHeader.Sorted = SortedNone
lstHeader.col = 2
lstHeader.ColSortSeq = 0
lstHeader.ColSortDataType = ColSortDataTypeTextNoCase
lstHeader.ColSorted = SortedAscending
lstHeader.Sorted = SortedAscending
' lstHeader.Sorted
ElseIf cboSort.ListIndex = 1 Then
lstHeader.col = 2
lstHeader.ColSortSeq = -1
' lstHeader.ColSortDataType = ColSortDataTypeTextNoCase
lstHeader.ColSorted = SortedNone
lstHeader.Sorted = SortedNone
lstHeader.col = 8
lstHeader.ColSortSeq = 0
lstHeader.ColSortDataType = ColSortDataTypeTextNoCase
' lstHeader.ColSortDataType = ColSortDataTypeDate
lstHeader.ColSorted = SortedDescending
lstHeader.Sorted = SortedDescending
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_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()
' mintBOOKMARK = lstDetail.ListIndex
mintBOOK = lstHeader.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
Call FormSave
lstHeader.ListIndex = mintBOOK
' lstDetail.Enabled = True
' lstDetail.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
End Sub
Private Sub Form_Load()
Call ARCodeLoad
' Call HeaderLoad
End Sub
'Private Sub ProjLoad()
'Dim strSQL As String
' On Error GoTo Error_EH
' strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID
' Set moRSProj = New Recordset
' moRSProj.Open strSQL, goConn, _
' adOpenForwardOnly, adLockReadOnly
' Exit Sub
'Error_EH:
' gstrMODULE = "Form APFix - Module ProjLoad"
' Call ErrorHandler2
' gstrMODULE = ""
' Exit Sub
'End Sub
Private Sub ARCodeLoad()
Dim oRS As Recordset
Dim strSQL As String, intRows As Integer, strLine As String
Dim row, col As Long
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARMaster"
' strSQL = "SELECT Bill_Id, Cust_no, Name FROM tblARMaster"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
strLine = Field2Str2(oRS!Bill_ID) & vbTab & Field2Str(oRS!Cust_NO) & vbTab & Field2Str(oRS!Name) ' & vbTab & Field2Str(oRS!Name) & vbTab & Field2Str(oRS!Name) '& vbTab & Field2Str(oRS!Name)
cboARCode.AddItem strLine
' cboARCode.ItemData(cboARCode.NewIndex) = Field2Long(oRS!bill_id)
oRS.MoveNext
Loop
oRS.Close
' cboARCode.ListIndex = 0
cboARCode.ListIndex = -1
Exit Sub
Error_EH:
gstrMODULE = "Form APFix - Module APCodeLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
' With moRSDetail
' txtInvDate = Field2Str(!invoice_date)
' txtDueDate = Field2Str(!inv_due_date)
' txtItemAmt = Format(Field2Str2(!amount), "currency")
' txtSalesCode = Field2Str(!sales_code)
' txtTax = Field2Str(!taxcode)
' chkReady = Field2CheckBox(!ready)
' End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form APFix - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
Exit Sub
Error_EH:
gstrMODULE = "Form APFix - Module FormSave"
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 tblARInvoice "
' strSQL = strSQL & "WHERE trans_id = " & lstDetail.ItemData(lstDetail.ListIndex)
' Set moRSDetail = New Recordset
' moRSDetail.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSHeader.EOF Then
FormFind = False
Else
FormFind = True
msglInvTotal = moRSHeader!non_tax_amt
mstrType = moRSHeader!inv_type
gintPROJID = moRSHeader!PROJ_ID
' Call ProjLoad
End If
Exit Function
Error_EH:
gstrMODULE = "Form APFix - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
'Private Sub lstDetail_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
' !invoice_date = Str2Field(txtInvDate)
!JobNumber = Str2Field(txtDueDate)
' !price = Str2Field(txtItemAmt)
' !amount = Str2Field(txtItemAmt)
' !sales_code = Str2Field(txtSalesCode)
.Update
End With
' strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID & " and not done"
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' msglInvTotal = Field2Str2(oRS!sglTOTAL)
' strSQL = "SELECT * FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
' Do Until oRS.EOF
' With oRS
' !invoice_date = Str2Field(txtInvDate)
' !inv_due_date = Str2Field(txtDueDate)
' !ready = chkReady
' !non_tax_amt = msglInvTotal
' !taxcode = Str2Field(txtTax)
' If Field2Str2(moRSProj!retention) > 0 Then
' !retention_amt = Format(((msglInvTotal * Field2Str2(moRSProj!retention) / 100)), "#.00")
' Else
' !retention_amt = 0
' End If
' .Update
' End With
' oRS.MoveNext
' Loop
Call HeaderLoad
Exit Sub
Error_EH:
gstrMODULE = "Form APFix - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
' If lstHeader.ListCount = 0 Then
' intResponse = MsgBox("No Invoices For This Builder - Select A Different Builder.", vbExclamation + vbOKOnly, "Exit Form")
' Unload Me
' End If
End Sub
Private Sub FormClear()
txtInvDate = ""
txtDueDate = ""
txtSalesCode = ""
txtItemAmt = ""
' chkReady = vbUnchecked
End Sub
'Private Sub lstDetail_DblClick()
' cmdSave.Enabled = True
'End Sub
Private Sub lstHeader_Click()
Dim strSQL As String, oRS As Recordset
Dim strID As String
On Error GoTo Error_EH
If lstHeader.ListIndex <> -1 Then
lstHeader.col = 0
strID = lstHeader.ColText
strSQL = "SELECT * FROM ARN_InvHistoryHeader WHERE ar_id = " & strID
Set moRSHeader = New Recordset
moRSHeader.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not moRSHeader.EOF Then
txtSalesCode = Format(Field2Str(moRSHeader!TaxableSalesAmount), "#,#.00")
txtDueDate = Field2Str(moRSHeader!JobNumber)
txtInvDate = Field2Str(moRSHeader!InvoiceNumber)
txtItemAmt = Field2Str2(moRSHeader!seqnumber)
Else
txtSalesCode = ""
txtDueDate = ""
txtInvDate = ""
txtItemAmt = ""
End If
' txtDueDate.SetFocus
End If
Exit Sub
Error_EH:
gstrMODULE = "Form APFix - Module lstHeader_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstHeader_DblClick()
cmdSave.Enabled = True
txtDueDate.SetFocus
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 txtInvDate_LostFocus()
'Dim lngPOS As Long
' lngPOS = InStr(1, txtInvDate, "/", 1)
' If lngPOS = 0 Then
' If Len(txtInvDate) > 0 Then
' txtInvDate = Format(txtInvDate, "00/00/####")
' If Not IsDate(txtInvDate) Then
' MsgBox "The Date You Entered is not Valid - ReEnter"
' txtInvDate.SetFocus
' End If
' End If
' ElseIf IsDate(txtInvDate) Then
' Exit Sub
' Else
' MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
' txtInvDate.SetFocus
' End If
'End Sub
'Private Sub txtItemAmt_GotFocus()
' Call FieldSelect(txtItemAmt)
' msglItemAmt = Single2Field(txtItemAmt)
'End Sub
'Private Sub txtItemAmt_LostFocus()
' If msglItemAmt < Field2Str2(txtItemAmt) Then
' msglInvTotal = msglInvTotal + Field2Str2(txtItemAmt)
' txtItemAmt = Format(txtItemAmt, "#,#.00")
' ElseIf msglItemAmt > Field2Str2(txtItemAmt) Then
' msglInvTotal = msglInvTotal - Field2Str2(txtItemAmt)
' txtItemAmt = Format(txtItemAmt, "#,#.00")
' ElseIf msglItemAmt = Field2Str(txtItemAmt) Then
' txtItemAmt = Format(txtItemAmt, "#,#.00")
' End If
'End Sub
'Private Sub txtSalesCode_GotFocus()
' Call FieldSelect(txtSalesCode)
'End Sub
'Private Sub txtSalesCode_LostFocus()
' txtSalesCode = UCase(txtSalesCode)
'End Sub
Private Sub cmdPrint_Click()
Dim oRS As Recordset, strSQL As String, strSELECT As String, strCUST As String
On Error GoTo Error_EH
cboARCode.col = 1
strCUST = cboARCode.ColText
gintCOPY = 1
strSQL = "SELECT * FROM ARN_InvHistoryHeader WHERE CustomerNumber = '" & strCUST & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' gstrPONUM = Field2Str(oRS!po_num)
' mstrPROJLOT = Field2Str(oRS!ProjLot)
' Call LotChange(mstrPROJLOT, "RePrint AR Invoice")
strSELECT = "{ARN_InvHistoryHeader.CustomerNumber}= '" & strCUST & "' and {ARN_InvHistoryHeader.JobNumber} = ''"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crAR.ReportFileName = App.Path & "\arblanks.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
Reference in New Issue View Git Blame Copy Permalink