azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
fa4ac2ea37a32e0fde79ff87a109ffbcb01dc787
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_PRNew/20171101FIX/frmMain.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

5113 lines
161 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Valley Wide Plastering"
ClientHeight = 8595
ClientLeft = 150
ClientTop = 720
ClientWidth = 11880
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMain.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 8595
ScaleWidth = 11880
StartUpPosition = 3 'Windows Default
Visible = 0 'False
Begin LpLib.fpList lstContains
Height = 3000
Left = 60
TabIndex = 44
Top = 4245
Visible = 0 'False
Width = 11775
_Version = 196608
_ExtentX = 20770
_ExtentY = 5292
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
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 = 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= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmMain.frx":068A
End
Begin VB.TextBox txtSContain
Height = 375
Left = 780
TabIndex = 6
Top = 2760
Width = 2475
End
Begin VB.CommandButton cmdFContain
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
Picture = "frmMain.frx":0A68
Style = 1 'Graphical
TabIndex = 5
Top = 2700
Width = 555
End
Begin VB.CommandButton cmdUpRGard
Caption = "Update OptNum"
Height = 615
Left = 5640
TabIndex = 42
Top = 7995
Visible = 0 'False
Width = 960
End
Begin VB.CommandButton cmdReNum
Caption = "ReNumber"
Height = 615
Left = 3975
TabIndex = 41
Top = 7950
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdFixBill
Caption = "Setup Billing"
Height = 555
Left = 1980
TabIndex = 40
Top = 8025
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton cmdHourly
Caption = "Hourly Payroll"
Height = 495
Left = 9855
TabIndex = 39
Top = 2985
Width = 1515
End
Begin VB.CommandButton cmdJCList
Caption = "Select JC List"
Height = 495
Left = 3360
TabIndex = 37
Top = 2460
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdFindSPO
Caption = "Find Special PO Info."
Height = 495
Left = 9840
TabIndex = 36
Top = 2460
Width = 1515
End
Begin VB.CommandButton cmdFindOrder
Caption = "Find Purchase Order"
Height = 495
Left = 4980
TabIndex = 35
Top = 2460
Width = 1515
End
Begin MSComDlg.CommonDialog cdMain
Left = 840
Top = 8085
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
DialogTitle = "Select Bank Rec File"
InitDir = "c:\BankOne"
End
Begin VB.CommandButton cmdChecks
Caption = "Verify Checks"
Height = 495
Left = 8220
TabIndex = 34
TabStop = 0 'False
Top = 2460
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdProjNotes
Caption = "Pro&Ject Notes"
Height = 495
Left = 6600
TabIndex = 33
TabStop = 0 'False
Top = 2460
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdInvoice
Caption = "Builder Invoice List"
Height = 495
Left = 9840
TabIndex = 32
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdShip
Caption = "Lot Invoice && Shipping"
Height = 495
Left = 9840
TabIndex = 31
TabStop = 0 'False
Top = 840
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdBilling
Caption = "Billing &Grid"
Height = 495
Left = 9840
TabIndex = 30
TabStop = 0 'False
Top = 1365
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdScafList
Caption = "Scaffold List"
Height = 495
Left = 9840
TabIndex = 29
TabStop = 0 'False
Top = 1920
Width = 1515
End
Begin VB.CommandButton cmdPrintJCRpt
Caption = "Print Only - Job Cost Reports"
Height = 495
Left = 8220
TabIndex = 28
TabStop = 0 'False
Top = 1920
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdJCRpt
Caption = "Calculate && Print Job Cost"
Height = 495
Left = 6585
TabIndex = 27
TabStop = 0 'False
Top = 1920
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdJCUpdate
Caption = "&Update Lot Job Code Info"
Height = 495
Left = 4980
TabIndex = 26
TabStop = 0 'False
Top = 1920
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdScaffold
Caption = "Scaffold Information"
Height = 495
Left = 3360
TabIndex = 25
TabStop = 0 'False
Top = 1920
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdPOInfo
Caption = "PO Information"
Height = 495
Left = 3360
TabIndex = 23
TabStop = 0 'False
Top = 840
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdLotInfo
Caption = "Lot &Information"
Height = 495
Left = 8220
TabIndex = 22
TabStop = 0 'False
Top = 1380
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdSchedule
Caption = "&Schedule Repair"
Height = 495
Left = 6585
TabIndex = 21
TabStop = 0 'False
Top = 1380
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdRepairList
Caption = "Repair List"
Height = 495
Left = 4980
TabIndex = 20
TabStop = 0 'False
Top = 1380
Width = 1515
End
Begin Crystal.CrystalReport crMain
Left = 195
Top = 8055
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdYardOrder
Caption = "&Yard Order Information"
Height = 495
Left = 8220
TabIndex = 19
TabStop = 0 'False
Top = 840
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdPOList
Caption = "Process Payroll"
Height = 495
Left = 3360
TabIndex = 18
TabStop = 0 'False
Top = 1380
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdDates
Caption = "Order &Dates"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6600
TabIndex = 17
TabStop = 0 'False
Top = 840
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 495
Left = 4980
TabIndex = 16
TabStop = 0 'False
Top = 840
Width = 1515
End
Begin VB.CommandButton cmdPayroll
Caption = "&Payroll Information"
Enabled = 0 'False
Height = 495
Left = 6600
TabIndex = 15
TabStop = 0 'False
Top = 240
Width = 1515
End
Begin VB.CommandButton cmdNewSearch
Caption = "&New Search"
Height = 495
Left = 8220
TabIndex = 14
TabStop = 0 'False
Top = 240
Width = 1515
End
Begin VB.CommandButton cmdPlans
Caption = "&Plans"
Enabled = 0 'False
Height = 495
Left = 1740
TabIndex = 13
TabStop = 0 'False
Top = 240
Width = 1515
End
Begin VB.TextBox txtSCode
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 780
TabIndex = 0
Top = 1200
Width = 2475
End
Begin VB.TextBox txtSName
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 780
TabIndex = 2
Top = 1980
Width = 2475
End
Begin VB.ListBox lstProject
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3570
Left = 705
Sorted = -1 'True
TabIndex = 9
TabStop = 0 'False
Top = 3990
Visible = 0 'False
Width = 2640
End
Begin VB.CommandButton cmdFCode
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
Picture = "frmMain.frx":0EAA
Style = 1 'Graphical
TabIndex = 1
Top = 1140
Width = 555
End
Begin VB.CommandButton cmdFName
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
Picture = "frmMain.frx":12EC
Style = 1 'Graphical
TabIndex = 3
Top = 1920
Width = 555
End
Begin VB.ListBox lstLots
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3570
Left = 3405
Sorted = -1 'True
TabIndex = 8
TabStop = 0 'False
Top = 3990
Visible = 0 'False
Width = 6000
End
Begin VB.CommandButton cmdTakeR
Caption = "&Takeoff"
Enabled = 0 'False
Height = 495
Left = 3375
TabIndex = 7
TabStop = 0 'False
Top = 240
Width = 1515
End
Begin VB.CommandButton cmdOrderR
Caption = "&Orders"
Enabled = 0 'False
Height = 495
Left = 4980
TabIndex = 10
Top = 240
Width = 1515
End
Begin VB.CommandButton cmdLotSearch
Caption = "&Lot Search"
Enabled = 0 'False
Height = 495
Left = 105
TabIndex = 4
TabStop = 0 'False
Top = 225
Width = 1515
End
Begin VB.Label lblContain
Caption = "Search Address Info"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 43
Top = 2385
Width = 2805
End
Begin VB.Label lblDesc
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 = 705
TabIndex = 38
Top = 3630
Visible = 0 'False
Width = 7320
End
Begin VB.Label lblProjCode
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 = 705
TabIndex = 24
Top = 3330
Visible = 0 'False
Width = 7320
End
Begin VB.Label lblCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Subdivision Code:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 12
Top = 840
Width = 1905
End
Begin VB.Label lblName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Subdivision Name:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 11
Top = 1620
Width = 1965
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuPrograms
Caption = "&Programs"
Begin VB.Menu mnuOrders
Caption = "&Orders"
Enabled = 0 'False
Begin VB.Menu mnuOrderR
Caption = "Orders Regular"
Checked = -1 'True
End
Begin VB.Menu mnuOrder5
Caption = "Orders PreMix/Typar"
End
Begin VB.Menu mnuOrderE
Caption = "Orders Synthetic"
End
End
Begin VB.Menu mnuPlans
Caption = "&Plans"
Enabled = 0 'False
End
Begin VB.Menu mnuTake
Caption = "&Takeoff"
Enabled = 0 'False
Begin VB.Menu mnuTakeR
Caption = "TakeOff Regular"
Checked = -1 'True
End
Begin VB.Menu mnuTake5
Caption = "TakeOff PreMix/Typar"
End
Begin VB.Menu mnuTakeE
Caption = "TakeOff Synthetic"
End
End
Begin VB.Menu mnuPayroll
Caption = "&Payroll Informaton"
Enabled = 0 'False
End
Begin VB.Menu mnuPOList
Caption = "Purchase Order &List"
End
Begin VB.Menu mnuMARUpdate
Caption = "Update Metro Stucco AR Master File"
End
Begin VB.Menu mnuARUPDATE
Caption = "Update AR Master File"
End
Begin VB.Menu mnuFIXAR
Caption = "Fix AR Invoice JC Information"
End
Begin VB.Menu mnuAPUPDATE
Caption = "Update AP Master File"
End
Begin VB.Menu mnuFIXAP
Caption = "Fix AP Invoice JC Information"
End
Begin VB.Menu mnuUpCheck
Caption = "&Update Check Information"
Visible = 0 'False
End
Begin VB.Menu mnuEstInv
Caption = "Estimator Inventory"
End
Begin VB.Menu mnuMARTransfer
Caption = "Setup Metro AR Transfer"
Enabled = 0 'False
End
Begin VB.Menu mnuTransfer
Caption = "Setup AR &Transfer"
Enabled = 0 'False
End
Begin VB.Menu mnuMJCTrans
Caption = "Metro JC Transfer Complete"
Enabled = 0 'False
End
Begin VB.Menu mnuJCTrans
Caption = "&JC Transfer Complete"
Enabled = 0 'False
End
Begin VB.Menu mnuAck
Caption = "Orders Shipped &Acknowlegement"
End
Begin VB.Menu mnuFoamOrder
Caption = "Foam Order Information"
End
Begin VB.Menu mnuPosPay
Caption = "Set&Up PosPay File"
Begin VB.Menu mnuABTPosPay
Caption = "AZ Bank and Trust"
End
Begin VB.Menu mnuWFPosPay
Caption = "Wells Fargo Account"
End
Begin VB.Menu mnuJPPosPay
Caption = "JP Morgan"
End
End
Begin VB.Menu mnuUInv
Caption = "Update Inventory Delivery Flag"
Enabled = 0 'False
Visible = 0 'False
End
Begin VB.Menu mnuSetupSWMAR
Caption = "Setup SW Metro AR Transfer"
End
Begin VB.Menu mnuSWTRANSFER
Caption = "Setup SW AR Transfer"
End
Begin VB.Menu mnuMAPTransfer
Caption = "Setup Metro AP Transfer"
End
Begin VB.Menu mnuAPTransfer
Caption = "Setup AP Transfer"
End
Begin VB.Menu mnuFindPO
Caption = "&Find PO ID Number"
End
End
Begin VB.Menu mnuUtilities
Caption = "&Utilities"
Begin VB.Menu mnuLabor
Caption = "&Labor Rates"
Enabled = 0 'False
End
Begin VB.Menu mnuSupplier
Caption = "&Suppliers"
Enabled = 0 'False
End
Begin VB.Menu mnuBP
Caption = "&Black Paper"
Enabled = 0 'False
End
Begin VB.Menu mnuTexture
Caption = "&Texture"
Enabled = 0 'False
End
Begin VB.Menu mnuContractor
Caption = "Cont&ractors"
Enabled = 0 'False
End
Begin VB.Menu mnuCrew
Caption = "Lath/Stucco &Crews"
Enabled = 0 'False
End
Begin VB.Menu mnuRCrew
Caption = "&Repair Crews"
Enabled = 0 'False
End
Begin VB.Menu mnuSCrew
Caption = "Scaffolding Drivers"
End
Begin VB.Menu mnuProject
Caption = "&Projects"
Enabled = 0 'False
End
Begin VB.Menu mnuScaffold
Caption = "Scaffold Setup"
Visible = 0 'False
End
Begin VB.Menu mnuInvList
Caption = "&Inventory List"
Enabled = 0 'False
End
Begin VB.Menu mnuInvPrice
Caption = "Inventory &Price"
Enabled = 0 'False
End
Begin VB.Menu mnuYInvList
Caption = "&Yard Inventory List"
Enabled = 0 'False
End
Begin VB.Menu mnuSand
Caption = "Sand &Zone"
Enabled = 0 'False
End
Begin VB.Menu mnuUser
Caption = "&Users"
Enabled = 0 'False
End
End
Begin VB.Menu mnuReports
Caption = "&Reports"
Begin VB.Menu mnuInvCount
Caption = "Inventory Count"
End
Begin VB.Menu mnuYardRange
Caption = "Yard Orders - Date Range"
End
Begin VB.Menu mnuYard1Date
Caption = "Yard Orders - 1 Date"
End
Begin VB.Menu mnuOrdersDate
Caption = "Texture Orders - Date Range"
Visible = 0 'False
End
Begin VB.Menu mnuLathList
Caption = "Lath Orders - Date Range"
Visible = 0 'False
End
Begin VB.Menu mnuPlanUse
Caption = "Plan Usage by Project"
End
Begin VB.Menu mnuProjPlan
Caption = "Project Plan Information"
End
Begin VB.Menu mnuBid
Caption = "&Bid Report"
End
Begin VB.Menu mnuVoid
Caption = "&Void Check List"
Visible = 0 'False
End
Begin VB.Menu mnuPOListdesc
Caption = "PO List in Descending Order"
End
Begin VB.Menu mnuMAPEdit
Caption = "Metro AP Edit List"
End
Begin VB.Menu mnuAPEdit
Caption = "AP &Edit List"
End
Begin VB.Menu mnuMAREdit
Caption = "Metro AR Edit List"
End
Begin VB.Menu mnuAREdit
Caption = "AR Edit List"
End
Begin VB.Menu mnuProjJC
Caption = "Project JC Summary"
Visible = 0 'False
End
Begin VB.Menu mnuRepList
Caption = "Report List"
End
End
Begin VB.Menu mnuMainHelp
Caption = "&Help"
Begin VB.Menu mnuHelp
Caption = "&Help"
End
Begin VB.Menu mnuLine
Caption = "-"
End
Begin VB.Menu mnuAbout
Caption = "&About"
End
End
Begin VB.Menu mnuTOI
Caption = "Tie Options"
Visible = 0 'False
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSProj As Recordset, moRS As Recordset
Dim mstrBegDate As String, mstrEndDate As String
Dim mboolSHOW As Boolean
Dim mboolPRINT As Boolean
Private Sub cmdBilling_Click()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
frmBilling.Show 1
End Sub
Private Sub cmdChecks_Click()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSql2 As String, strMSG As String
Dim strINPUT As String, strFile As String
Dim intCount As Integer, dblAMT As Double, intResponse As Integer
Dim intYear As Integer, intMonth As Integer, intDay As Integer
On Error GoTo CancelOpen
strSQL = "DELETE * FROM tblCheckRec"
goConn.Execute strSQL
cdMain.Filter = "Text Files|*.txt"
cdMain.Action = 1
strFile = cdMain.FileName
strSQL = "SELECT * FROM tblCheckRec"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Open strFile For Input As #1
Do While Not EOF(1)
strINPUT = Input(152, #1)
oRS.AddNew
oRS!check_no = Mid(strINPUT, 36, 6)
oRS!ck_name = Mid(strINPUT, 80, 15)
dblAMT = Mid(strINPUT, 43, 18)
oRS!ck_amt = dblAMT / 100
intYear = Mid(strINPUT, 62, 4)
intMonth = Mid(strINPUT, 66, 2)
intDay = Mid(strINPUT, 68, 2)
oRS!ck_date = DateSerial(intYear, intMonth, intDay)
oRS.Update
Loop
Close #1
strSQL = "SELECT * FROM tblCheckRec"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
Do Until oRS.EOF
strSql2 = "SELECT * FROM BR1_Transaction WHERE BankCode = '4' and TransactionType = 'C' and CheckNumber = '" & oRS!check_no & "' and SeqNo = '000'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
With oRS
!m90_amt = Field2Str2(oRSS!amount)
!m90_name = Left(Field2Str(oRSS!CheckPayeeName), 15)
If !ck_amt <> !m90_amt Then
!bad = vbChecked
End If
.Update
End With
Else
With oRS
!m90_amt = 0
!m90_name = "No MAS 90 Check Found"
!bad = vbChecked
.Update
End With
End If
' End With
' End If
oRS.MoveNext
Loop
strSQL = "SELECT * FROM tblCheckRec WHERE Bad"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
intCount = oRS.RecordCount
strMSG = "Bank Reconcilliation Files have been Compared" & vbLf & vbCr
strMSG = strMSG & intCount & " Checks did not match - Do You Want A Report"
intResponse = MsgBox(strMSG, vbYesNo, "Done")
If intResponse = vbYes Then
gintCOPY = 1
crMain.ReportFileName = App.Path & "\CheckRecErrors.rpt"
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.CopiesToPrinter = gintCOPY
crMain.WindowState = crptMaximized
crMain.Action = 1
crMain.Reset
Else
Exit Sub
End If
CancelOpen:
Exit Sub
End Sub
Private Sub cmdDates_Click()
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
Else
gintLOTID = 0
End If
frmOrderDates.Show 1
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFContain_Click()
If Len(txtSContain) > 0 Then
txtSContain.Enabled = False
txtSName.Enabled = False
Call ContainLoad
Else
MsgBox "Information To Find Must Be Entered", , "No Information"
txtSContain.SetFocus
End If
' cmdOrderR.Enabled = False
' mnuOrders.Enabled = False
If mboolSHOW Then
cmdLotSearch.Enabled = True
cmdProjNotes.Visible = True
If gbytSECURITY < 3 Then
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gstrLOGIN = "CKW" Then
' ElseIf gstrLOGIN = "AOB" Or gstrLOGIN = "CKW" Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 6 Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 7 Then
cmdBilling.Visible = True
End If
lstContains.SetFocus
Else
cmdNewSearch.Enabled = True
' txtSContain.Enabled = False
' txtSContain.SetFocus
End If
End Sub
Private Sub cmdFindOrder_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
gstrPONUM = UCase(InputBox("Enter The VWP PO Number You Want", "PO Number"))
If gstrPONUM = "" Then
' MsgBox "You Must Enter A Valid VWP PO Number", vbOKOnly, "No Valid PO"
Exit Sub
End If
strSQL = "SELECT PO_Num, Lot_ID FROM tblOrders WHERE po_num = '" & gstrPONUM & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
' gintLOTID = Field2Integer(oRS!Lot_id)
gintLOTID = Field2Long(oRS!Lot_id)
strSql2 = "SELECT lot_id, proj_id FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
gintPROJID = Field2Integer(oRSS!proj_id)
End If
Else
MsgBox "You Must Enter A Valid VWP PO Number", vbOKOnly, "No Valid PO"
Exit Sub
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
' gintORDER = 8
gintORDER = 9
frmOrders.Show 1
End Sub
Private Sub cmdFindSPO_Click()
' gintPONUM = Field2Integer(lblD_SPO)
On Error GoTo EH_ERROR
gintPONUM = UCase(InputBox("Enter The Special PO Number You Want", "PO Number"))
frmPOInfo.Show 1
Exit Sub
EH_ERROR:
MsgBox "Invalid Response", vbOKOnly, "Invalid"
Exit Sub
End Sub
Private Sub cmdFixBill_Click()
Dim oRSPlan As Recordset, oRSPlanBIll As Recordset, oRSOPT As Recordset, oRSOptBill As Recordset, oRSProjDate As Recordset
Dim strSQL As String, strSQL1 As String, strSql2 As String, strSQL3 As String, strSQL4 As String
Dim lngESTID As Long, lngProjID As Long, strCONVERT As String, lngUsedProj As Long
strCONVERT = "07/01/2004"
strSQL = "SELECT * FROM tblLotInfo WHERE STARTDATE is null" ' ORDER BY Proj_ID"
Set oRSPlan = New Recordset
oRSPlan.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' strSQL1 = "SELECT * FROM tblPlanBill"
' Set oRSPlanBIll = New Recordset
' oRSPlanBIll.Open strSQL1, goConn, adOpenKeyset, adLockOptimistic
' strSql2 = "SELECT * FROM tblPOption" ' WHERE Est_id = " & lngESTID
' Set oRSOPT = New Recordset
' oRSOPT.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
' strSQL3 = "SELECT * FROM tblPoptbill"
' Set oRSOptBill = New Recordset
' oRSOptBill.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic
' strSQL4 = "SELECT * FROM tblprojdate"
' Set oRSProjDate = New Recordset
' oRSProjDate.Open strSQL4, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSPlan.EOF
' On Error GoTo EH_ERROR_PLANS
strCONVERT = "01/01/2005"
oRSPlan!startdate = strCONVERT
oRSPlan.Update
oRSPlan.MoveNext
Loop
' lngProjID = Field2Long(oRSPlan!proj_id)
' lngESTID = Field2Long(oRSPlan!est_id)
' With oRSPlanBIll
' .AddNew
' !proj_id = Field2Long(oRSPlan!proj_id)
' !est_id = Field2Long(oRSPlan!est_id)
' !mod_elv = Field2Str(oRSPlan!mod_elv)
' !l_bill = Field2Str2(oRSPlan!l_bill)
' !s_bill = Field2Str2(oRSPlan!s_bill)
' !Create = oRSPlan!Create
' !LSave = oRSPlan!LSave
' !LSUser = Field2Str(oRSPlan!LSUser)
' !createuser = (oRSPlan!createuser)
' !CreateUser = Field2Str(oRSPlan!CreateUser)
' !notes = Field2Str(oRSPlan!notes)
' !BUpdate = oRSPlan!BUpdate
' !BUUser = oRSPlan!BUUser
' !BUUSer = Field2Str(oRSPlan!BUUSer)
' !l_code = Field2Str(oRSPlan!l_code)
' !s_code = Field2Str(oRSPlan!s_code)
' !st_bill = Field2Str2(oRSPlan!st_bill)
' !st_code = Field2Str(oRSPlan!st_code)
' !Update = oRSPlan!Update
' !LUUser = (oRSPlan!LUUser)
'' !LUUser = Field2Str(oRSPlan!LUUser)
' If IsNull(oRSPlan!effdate) Then
' !effdate = strCONVERT
' Else
' !effdate = oRSPlan!effdate
' strCONVERT = oRSPlan!effdate
' End If
' .Update
' End With
'' On Error GoTo EH_ERROR_PROJDATE
' If lngUsedProj <> lngProjID Then
' oRSProjDate.AddNew
' oRSProjDate!proj_id = lngProjID
' oRSProjDate!startdate = strCONVERT
' lngUsedProj = Field2Long(oRSPlan!proj_id)
' oRSProjDate.Update
' End If
'' oRSPlan.MoveNext
'' Loop
' On Error GoTo EH_ERROR_OPT
' strSql2 = "SELECT * FROM tblPOption WHERE Est_id = " & lngESTID
' Set oRSOPT = New Recordset
' oRSOPT.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
'
' Do Until oRSOPT.EOF
' With oRSOptBill
' .AddNew
' !est_id = Field2Long(oRSOPT!est_id)
' !OPTID = Field2Long(oRSOPT!OPTID)
' !opt_no = Field2Str2(oRSOPT!opt_no)
' !Desc = Field2Str(oRSOPT!Desc)
' !b_code = (oRSOPT!b_code)
'' !created = Field2Str2(oRSOPT!created)
' !Updated = (oRSOPT!Updated)
' !C_USER = (oRSOPT!C_USER)
' !U_USER = (oRSOPT!U_USER)
' !amt = Field2Str2(oRSOPT!amt)
' If IsNull(oRSOPT!effdate) Then
' !effdate = strCONVERT
'' Else
' !effdate = Field2Str2(oRSOPT!effdate)
' End If
'' .Update
' oRSOPT.MoveNext
' End With
' Loop
'
'' On Error GoTo EH_ERROR_PROJDATE
' oRSProjDate.AddNew
' oRSProjDate!proj_id = lngProjID
' oRSProjDate!startdate = strCONVERT
' oRSProjDate.Update
' oRSPlan.MoveNext
' Loop
MsgBox "Plan Billing Update COmpleted"
Exit Sub
EH_ERROR_PLANS:
oRSPlanBIll.Cancel
Resume Next
EH_ERROR_OPT:
oRSOptBill.Cancel
Resume Next
EH_ERROR_PROJDATE:
oRSProjDate.Cancel
Resume Next
End Sub
Private Sub cmdHourly_Click()
frmHourList.Show 1
End Sub
Private Sub cmdInvoice_Click()
frmAR.Show 1
End Sub
Private Sub cmdJCList_Click()
frmJCList.Show
End Sub
Private Sub cmdJCRpt_Click()
mboolPRINT = False
Screen.MousePointer = vbHourglass
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
Call CalcJobCost
If mboolPRINT Then
Call cmdPrintJCRpt_Click
End If
Call ToggleButtons1
Screen.MousePointer = vbDefault
lstLots.SetFocus
End Sub
Private Sub ToggleButtons1()
cmdJCUpdate.Enabled = Not cmdJCUpdate.Enabled
cmdExit.Enabled = Not cmdExit.Enabled
cmdDates.Enabled = Not cmdDates.Enabled
cmdLotInfo.Enabled = Not cmdLotInfo.Enabled
cmdLotSearch.Enabled = Not cmdLotSearch.Enabled
cmdNewSearch.Enabled = Not cmdNewSearch.Enabled
cmdOrderR.Enabled = Not cmdOrderR.Enabled
cmdPayroll.Enabled = Not cmdPayroll.Enabled
cmdPrintJCRpt.Enabled = Not cmdPrintJCRpt.Enabled
cmdJCRpt.Enabled = Not cmdJCRpt.Enabled
cmdPOInfo.Enabled = Not cmdPOInfo.Enabled
cmdPOList.Enabled = Not cmdPOList.Enabled
cmdRepairList.Enabled = Not cmdRepairList.Enabled
cmdScaffold.Enabled = Not cmdScaffold.Enabled
cmdSchedule.Enabled = Not cmdSchedule.Enabled
cmdYardOrder.Enabled = Not cmdYardOrder.Enabled
cmdScafList.Enabled = Not cmdScafList.Enabled
cmdBilling.Enabled = Not cmdBilling.Enabled
End Sub
Private Sub CalcJobCost2()
Dim oRS As Recordset, oRSC As Recordset, oRSD As Recordset, oRSF As Recordset
Dim strSQL As String, strCALC As String, strSql2 As String, dblCALC As Double
Dim intCALC As Integer, strJOBCOST As String, strREPORT As String, strFIND As String
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
Call ToggleButtons1
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
MsgBox "No Lot Was Found, Try Again", vbOKOnly, "Select Lot"
Exit Sub
Else
If IsNull(oRS!jobcost) Or oRS!jobcost = "" Then
MsgBox "There is No Job Cost Code For This Lot - Enter One", vbOKOnly, "Enter JobCost Code"
Exit Sub
Else
strJOBCOST = Field2Str(oRS!jobcost)
End If
End If
strSQL = "DELETE * FROM tblJobCost WHERE lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblJobCost_Rpt WHERE lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "SELECT * FROM tbljobcost WHERE lot_id = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strREPORT = "SELECT * FROM tblJobCost_Rpt where Lot_id = 1"
Set oRSD = New Recordset
oRSD.Open strREPORT, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblORDERS WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 1
oRSD!desc1 = Field2Str(!po_num)
oRSD!desc2 = Field2Str2(!supplier)
If !d_flag = "Y" Then
oRSD!desc3 = "Yard"
Else
oRSD!desc3 = "Supplier"
End If
If !m_type = "L" Then
oRSD!desc4 = "Lath"
ElseIf !m_type = "P" Then
oRSD!desc4 = "PreOrder"
ElseIf !m_type = "R" Then
oRSD!desc4 = "PO"
ElseIf !m_type = "A" Then
oRSD!desc4 = "Sand"
ElseIf !m_type = "S" Then
oRSD!desc4 = "Scratch"
ElseIf !m_type = "B" Then
oRSD!desc4 = "Brown"
ElseIf !m_type = "T" Then
oRSD!desc4 = "Texture"
End If
oRSD!date1 = Field2Str2(!order_date)
oRSD!amount1 = Field2Str2(!orderamt)
oRSD!Create = gstrLOGIN
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(pay_amt) as SUMPAY FROM tblTIME WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Payroll Information For This Lot", vbOKOnly, "No Payroll"
Else
dblCALC = Field2Str2(oRSC!sumpay)
strCALC = "TOTAL PAYROLL"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT * FROM tblTIME WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 4
If !pay_type = "S" Then
oRSD!desc1 = "STUCCO"
ElseIf !pay_type = "L" Then
oRSD!desc1 = "LATH"
End If
strFIND = "SELECT crew_id, crew_boss FROM tblCREW WHERE crew_id = " & Field2Str2(!crew)
Set oRSF = New Recordset
oRSF.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSF.EOF Then
oRSD!desc2 = Field2Str2(oRSF!crew_boss)
Else
oRSD!desc2 = "NO CREW FOUND"
End If
If !workdone = "C" Then
oRSD!desc3 = "COMPLETE"
ElseIf !workdone = "P" Then
oRSD!desc3 = "PARTIAL"
ElseIf !workdone = "T" Then
oRSD!desc3 = "TEXTURE"
ElseIf !workdone = "S" Then
oRSD!desc3 = "SCRATCH"
ElseIf !workdone = "B" Then
oRSD!desc3 = "BROWN"
ElseIf !workdone = "U" Then
oRSD!desc3 = "CMU"
ElseIf !workdone = "F" Then
oRSD!desc3 = "FENCE"
ElseIf !workdone = "W" Then
oRSD!desc3 = "WORKORDER/REPAIR"
End If
oRSD!date1 = !prdate
oRSD!desc4 = Field2Str2(!prcheck)
oRSD!amount1 = Field2Str2(!pay_amt)
oRSD!Create = gstrLOGIN
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Payables Information For This Lot", vbOKOnly, "No Payables"
Else
dblCALC = Field2Str2(oRSC!sumap)
strCALC = "TOTAL ACCOUNTS PAYABLE"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT VendorNumber, JobNumber, InvoiceNumber, DistributionAmount FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 2
oRSD!desc1 = Field2Str(!VendorNumber)
oRSD!desc2 = Field2Str2(!invoicenumber)
oRSD!desc3 = Field2Str2(!JobNumber)
oRSD!amount1 = Field2Str2(!distributionamount)
oRSD!Create = gstrLOGIN
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(TaxableSalesAmount+NonTaxableSalesAmount+SalesTaxAmount) as SUMBILL from ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Billing Information For This Lot", vbOKOnly, "No Billings"
Else
dblCALC = Field2Str2(oRSC!sumbill)
strCALC = "TOTAL BILLINGS"
intCALC = 0
GoSub Save_Info
End If
strSql2 = "SELECT CustomerNumber, JobNumber, TaxableSalesAmount, NonTaxableSalesAmount, SalesTaxAmount, InvoiceNumber, InvoiceDate FROM ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 5
oRSD!desc1 = Field2Str(!invoicenumber)
oRSD!desc2 = Field2Str2(!CustomerNumber)
oRSD!desc3 = Field2Str2(!JobNumber)
oRSD!date1 = Field2Str(!InvoiceDate)
oRSD!amount1 = (CDec(Field2Str2(!TaxableSalesAmount)) + CDec(Field2Str2(!NonTaxableSalesAmount)) + CDec(Field2Str2(!SalesTaxAmount)))
oRSD!Create = gstrLOGIN
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(QtyIssue*Price) as SUMYARD FROM tblYardOrder WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Yard Order Information For This Lot", vbOKOnly, "No Yard Order"
Else
dblCALC = Field2Str2(oRSC!sumyard)
strCALC = "TOTAL YARD ORDER"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT * FROM tblYardORDER WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 3
oRSD!desc1 = Field2Str(!inv_no)
oRSD!desc2 = Field2Str2(!Desc)
oRSD!date1 = !issued
' oRSD!date1 = Field2Str2(!issued)
oRSD!number1 = Field2Str2(!qtyIssue)
oRSD!amount1 = Field2Str2(!price)
oRSD!Create = gstrLOGIN
oRSD.Update
End With
oRSC.MoveNext
Loop
MsgBox "Job Cost Summary Calculation is Complete", vbOKOnly, "JC Calculation"
mboolPRINT = True
Exit Sub
Save_Info:
oRS.AddNew
oRS!Lot_id = gintLOTID
oRS!calc_date = Date
oRS!Amt = Field2Str2(dblCALC)
oRS!Desc = Field2Str(strCALC)
oRS!Type = intCALC
oRS!Create = gstrLOGIN
oRS.Update
Return
Error_EH:
gstrMODULE = "Form Main - Module CalcJobCost2"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CalcJobCost()
Dim oRS As Recordset, oRSC As Recordset, oRSD As Recordset, oRSF As Recordset
Dim strSQL As String, strCALC As String, strSql2 As String, dblCALC As Double
Dim intCALC As Integer, strJOBCOST As String, strREPORT As String, strFIND As String
Dim strCont As String, strProj As String, strPROJCODE As String, strLOTNO As String
Dim strMODEL As String, strADD As String, strOWNER As String
Dim intYDS As Integer, intMETAL As Integer
' On Error GoTo Error_EH
' Call ToggleButtons1
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
MsgBox "No Lot Was Found, Try Again", vbOKOnly, "Select Lot"
Exit Sub
Else
If IsNull(oRS!jobcost) Or oRS!jobcost = "" Then
MsgBox "There is No Job Cost Code For This Lot - Enter One", vbOKOnly, "Enter JobCost Code"
Exit Sub
Else
strCALC = "SELECT * FROM tblproject WHERE proj_id = " & Field2Long(oRS!proj_id)
Set oRSC = New Recordset
oRSC.Open strCALC, goConn, adOpenForwardOnly, adLockReadOnly
strJOBCOST = Field2Str(oRS!jobcost)
strMODEL = Field2Str(oRS!model)
strADD = Field2Str(oRS!address)
strOWNER = Field2Str(oRS!Owner)
strLOTNO = Field2Str(oRS!lot_no)
strCont = Field2Str(oRSC!proj_cont)
strProj = Field2Str(oRSC!proj_desc)
strPROJCODE = Field2Str(oRSC!proj_code)
intYDS = Field2Integer(oRS!sq_yd)
intMETAL = Field2Integer(oRS!METAL)
End If
End If
strSQL = "DELETE * FROM tblJobCost WHERE lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblJobCost_Rpt WHERE lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "SELECT * FROM tbljobcost WHERE lot_id = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strREPORT = "SELECT * FROM tblJobCost_Rpt where Lot_id = 1"
Set oRSD = New Recordset
oRSD.Open strREPORT, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblORDERS WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 1
oRSD!desc1 = Field2Str(!po_num)
oRSD!desc2 = Field2Str2(!supplier)
If !d_flag = "Y" Then
oRSD!desc3 = "Yard"
Else
oRSD!desc3 = "Supplier"
End If
If !m_type = "L" Then
oRSD!desc4 = "Lath"
ElseIf !m_type = "P" Then
oRSD!desc4 = "PreOrder"
ElseIf !m_type = "R" Then
oRSD!desc4 = "PO"
ElseIf !m_type = "A" Then
oRSD!desc4 = "Sand"
ElseIf !m_type = "S" Then
oRSD!desc4 = "Scratch"
ElseIf !m_type = "B" Then
oRSD!desc4 = "Brown"
ElseIf !m_type = "T" Then
oRSD!desc4 = "Texture"
End If
oRSD!date1 = Field2Str2(!order_date)
oRSD!amount1 = Field2Str2(!orderamt)
oRSD!Create = gstrLOGIN
oRSD!contr = strCont
oRSD!project = strProj
oRSD!projcode = strPROJCODE
oRSD!lotno = strLOTNO
oRSD!jc = strJOBCOST
oRSD!model = strMODEL
oRSD!address = strADD
oRSD!Owner = strOWNER
oRSD!SQYDS = intYDS
oRSD!METAL = intMETAL
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(pay_amt) as SUMPAY FROM tblTIME WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Payroll Information For This Lot", vbOKOnly, "No Payroll"
Else
dblCALC = Field2Str2(oRSC!sumpay)
strCALC = "TOTAL PAYROLL"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT * FROM tblTIME WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 4
If !pay_type = "S" Then
oRSD!desc1 = "STUCCO"
ElseIf !pay_type = "L" Then
oRSD!desc1 = "LATH"
End If
strFIND = "SELECT crew_id, crew_boss FROM tblCREW WHERE crew_id = " & Field2Str2(!crew)
Set oRSF = New Recordset
oRSF.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSF.EOF Then
oRSD!desc2 = Field2Str2(oRSF!crew_boss)
Else
oRSD!desc2 = "NO CREW FOUND"
End If
If !workdone = "C" Then
oRSD!desc3 = "COMPLETE"
ElseIf !workdone = "P" Then
oRSD!desc3 = "PARTIAL"
ElseIf !workdone = "T" Then
oRSD!desc3 = "TEXTURE"
ElseIf !workdone = "S" Then
oRSD!desc3 = "SCRATCH"
ElseIf !workdone = "B" Then
oRSD!desc3 = "BROWN"
ElseIf !workdone = "U" Then
oRSD!desc3 = "CMU"
ElseIf !workdone = "F" Then
oRSD!desc3 = "FENCE"
ElseIf !workdone = "W" Then
oRSD!desc3 = "WORKORDER/REPAIR"
End If
oRSD!date1 = !prdate
oRSD!desc4 = Field2Str2(!prcheck)
oRSD!amount1 = Field2Str2(!pay_amt)
oRSD!Create = gstrLOGIN
oRSD!contr = strCont
oRSD!project = strProj
oRSD!projcode = strPROJCODE
oRSD!lotno = strLOTNO
oRSD!jc = strJOBCOST
oRSD!model = strMODEL
oRSD!address = strADD
oRSD!Owner = strOWNER
oRSD!SQYDS = intYDS
oRSD!METAL = intMETAL
oRSD.Update
End With
oRSC.MoveNext
Loop
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strSql2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Payables Information For This Lot", vbOKOnly, "No Payables"
Else
dblCALC = Field2Str2(oRSC!sumap)
strCALC = "TOTAL ACCOUNTS PAYABLE"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT VendorNumber, JobNumber, InvoiceNumber, DistributionAmount FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 2
oRSD!desc1 = Field2Str(!VendorNumber)
oRSD!desc2 = Field2Str2(!invoicenumber)
oRSD!desc3 = Field2Str2(!JobNumber)
oRSD!amount1 = Field2Str2(!distributionamount)
oRSD!Create = gstrLOGIN
oRSD!contr = strCont
oRSD!project = strProj
oRSD!projcode = strPROJCODE
oRSD!lotno = strLOTNO
oRSD!jc = strJOBCOST
oRSD!model = strMODEL
oRSD!address = strADD
oRSD!Owner = strOWNER
oRSD!SQYDS = intYDS
oRSD!METAL = intMETAL
oRSD.Update
End With
oRSC.MoveNext
Loop
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strSql2 = "SELECT sum(TaxableSalesAmount+NonTaxableSalesAmount+SalesTaxAmount) as SUMBILL from ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Billing Information For This Lot", vbOKOnly, "No Billings"
Else
dblCALC = Field2Str2(oRSC!sumbill)
strCALC = "TOTAL BILLINGS"
intCALC = 0
GoSub Save_Info
End If
strSql2 = "SELECT CustomerNumber, JobNumber, TaxableSalesAmount, NonTaxableSalesAmount, SalesTaxAmount, InvoiceNumber, InvoiceDate FROM ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'"
Set oRSC = New Recordset
oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 5
oRSD!desc1 = Field2Str(!invoicenumber)
oRSD!desc2 = Field2Str2(!CustomerNumber)
oRSD!desc3 = Field2Str2(!JobNumber)
oRSD!date1 = Field2Str(!InvoiceDate)
oRSD!amount1 = (CDec(Field2Str2(!TaxableSalesAmount)) + CDec(Field2Str2(!NonTaxableSalesAmount)) + CDec(Field2Str2(!SalesTaxAmount)))
oRSD!Create = gstrLOGIN
oRSD!contr = strCont
oRSD!project = strProj
oRSD!projcode = strPROJCODE
oRSD!lotno = strLOTNO
oRSD!jc = strJOBCOST
oRSD!model = strMODEL
oRSD!address = strADD
oRSD!Owner = strOWNER
oRSD!SQYDS = intYDS
oRSD!METAL = intMETAL
oRSD.Update
End With
oRSC.MoveNext
Loop
strSql2 = "SELECT sum(QtyIssue*Price) as SUMYARD FROM tblYardOrder WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRSC.EOF Then
MsgBox "No Yard Order Information For This Lot", vbOKOnly, "No Yard Order"
Else
dblCALC = Field2Str2(oRSC!sumyard)
strCALC = "TOTAL YARD ORDER"
intCALC = 1
GoSub Save_Info
End If
strSql2 = "SELECT * FROM tblYardORDER WHERE lot_id = " & gintLOTID
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSC.EOF
With oRSC
oRSD.AddNew
oRSD!Lot_id = gintLOTID
oRSD!Type = 3
oRSD!desc1 = Field2Str(!inv_no)
oRSD!desc2 = Field2Str2(!Desc)
oRSD!date1 = !issued
' oRSD!date1 = Field2Str2(!issued)
oRSD!number1 = Field2Str2(!qtyIssue)
oRSD!amount1 = Field2Str2(!price)
oRSD!Create = gstrLOGIN
oRSD!contr = strCont
oRSD!project = strProj
oRSD!projcode = strPROJCODE
oRSD!lotno = strLOTNO
oRSD!jc = strJOBCOST
oRSD!model = strMODEL
oRSD!address = strADD
oRSD!Owner = strOWNER
oRSD!SQYDS = intYDS
oRSD!METAL = intMETAL
oRSD.Update
End With
oRSC.MoveNext
Loop
' MsgBox "Job Cost Summary Calculation is Complete", vbOKOnly, "JC Calculation"
mboolPRINT = True
If oRS.State = adStateOpen Then
oRS.Close
Set oRS = Nothing
End If
If oRSF.State = adStateOpen Then
oRSF.Close
Set oRSF = Nothing
End If
If oRSD.State = adStateOpen Then
oRSD.Close
Set oRSD = Nothing
End If
If oRSC.State = adStateOpen Then
oRSC.Close
Set oRSC = Nothing
End If
Exit Sub
Save_Info:
oRS.AddNew
oRS!Lot_id = gintLOTID
oRS!calc_date = Date
oRS!Amt = Field2Str2(dblCALC)
oRS!Desc = Field2Str(strCALC)
oRS!Type = intCALC
oRS!Create = gstrLOGIN
oRS.Update
Return
Error_EH:
gstrMODULE = "Form Main - Module CalcJobCost"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdJCUpdate_Click()
Dim strSQL As String, strJC As String
Dim oRS As Recordset
On Error GoTo Error_EH
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
Else
MsgBox "You Must Select A Lot Before Pressing This Button", vbOKOnly, "Select Lot"
gintLOTID = 0
Exit Sub
End If
strSQL = "SELECT lot_id, jobcost, lot_no FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
With oRS
If Not IsNull(!jobcost) Then
strJC = InputBox("Enter the JC Code for the HiLited Lot", "Update JC Code", Field2Str(!jobcost))
Else
!jobcost = Field2Str(moRSProj!jccode) & Format(Left(Field2Str(!lot_no), 3), "000")
strJC = InputBox("Enter the JC Code for the HiLited Lot", "Update JC Code", Field2Str(!jobcost))
End If
!jobcost = UCase$(Field2Str(strJC))
.Update
End With
End If
lstLots.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module cmdPrintPOInfo_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdLotInfo_Click()
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmLotList.Show 1
End Sub
Private Sub cmdOrderR_Click()
If cmdOrderR.Caption = "Orders" Then
If gboolBAG = True Or gboolSYN = True Then
MsgBox "This Is The Wrong Lot Information For This Project - Change The Project Info", vbOKOnly
Exit Sub
Else
Call cmdOrder_Click
End If
End If
If cmdOrderR.Caption = "Orders PreMix" Then
If gboolBAG = False And gboolSYN = False Then
MsgBox "This Is The Wrong Lot Information For This Project - Change The Project Info", vbOKOnly
Exit Sub
Else
Call cmdOrder5_Click
End If
End If
If cmdOrderR.Caption = "Orders Synthetic" Then
If gboolBAG = False And gboolSYN = False Then
MsgBox "This Is The Wrong Lot Information For This Project - Change The Project Info", vbOKOnly
Exit Sub
Else
Call cmdOrderE_Click
End If
End If
End Sub
Private Sub cmdPayroll_Click()
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmPayroll.Show 1
End Sub
Private Sub cmdPOInfo_Click()
Dim strSQL As String
On Error GoTo Error_EH
gintPRINT = 1
strSQL = "{tblOrders.Lot_id} = " & lstLots.ItemData(lstLots.ListIndex)
crMain.ReportFileName = App.Path & "\POInfo.rpt"
crMain.SelectionFormula = strSQL
crMain.Destination = crptToWindow
' crmain.Destination = crptToPrinter
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module cmdPrintPOInfo_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPOList_Click()
frmPayList.Show ' 1
End Sub
Private Sub cmdPrintJCRpt_Click()
Dim strSQL As String
' On Error GoTo Error_EH
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintCOPY = 1
crMain.Reset
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
' strSQL = gintLOTID
crMain.ReportFileName = App.Path & "\jobcost.rpt"
' crMain.SelectionFormula = strSQL
crMain.GroupSelectionFormula = strSQL
crMain.CopiesToPrinter = gintCOPY
' crmain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
crMain.Reset
' crMain.ReportFileName = App.Path & "\lath.rpt"
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crMain.ReportFileName = App.Path & "\jobcost2.rpt"
crMain.SelectionFormula = strSQL
crMain.CopiesToPrinter = gintCOPY
' crmain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintJCRpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdProjNotes_Click()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
frmProjNotes.Show 1
End Sub
Private Sub cmdReNum_Click()
Dim oRS As Recordset, strSQL As String, strUPDATE As String
strSQL = "SELECT * FROM tblLotMatrl"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockReadOnly
strUPDATE = "UPDATE tblYardOrder set SPLIT=0 "
goConn.Execute strUPDATE
End Sub
Private Sub cmdRepairList_Click()
frmRepair.Show 1
End Sub
Private Sub cmdScaffold_Click()
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmScaffold.Show 1
End Sub
Private Sub cmdScafList_Click()
frmScafList.Show 1
End Sub
Private Sub cmdSchedule_Click()
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmRepairLot.Show 1
End Sub
Private Sub cmdShip_Click()
frmBillingStatus.Show 1
End Sub
Private Sub cmdTakeR_Click()
If cmdTakeR.Caption = "Takeoff" Then
' If cmdTakeR.Caption = "&Takeoff" And gboolBAG = True Then
If gboolBAG = True Or gboolSYN = True Then
MsgBox "This Is The Wrong Takeoff For This Project - Change The Takeoff Type", vbOKOnly
Exit Sub
Else
' ElseIf Not gboolSYN Then
Call cmdTake_Click
End If
End If
' If cmdTakeR.Caption = "Takeoff Pre&Mix" Or cmdTakeR.Caption = "Takeoff S&ynthetic" Then
If cmdTakeR.Caption = "Takeoff PreMix" Then
If gboolBAG = False And gboolSYN = False Then
MsgBox "This Is The Wrong Takeoff For This Project - Change The Takeoff Type", vbOKOnly
Exit Sub
Else
Call cmdTake5_Click
End If
End If
' If cmdTakeR.Caption = "Takeoff Pre&Mix" Or cmdTakeR.Caption = "Takeoff S&ynthetic" Then
' If gboolBAG = False And gboolSYN = False Then
' MsgBox "This Is The Wrong Takeoff For This Project - Change The Takeoff Type", vbOKOnly
' Exit Sub
' Else
' Call cmdTake5_Click
' End If
' End If
If cmdTakeR.Caption = "Takeoff Synthetic" Then
If gboolBAG = False And gboolSYN = False Then
MsgBox "This Is The Wrong Takeoff For This Project - Change The Takeoff Type", vbOKOnly
Exit Sub
Else
Call cmdTakeE_Click
End If
End If
End Sub
Private Sub cmdUpRGard_Click()
Dim strSQL As String, oRS As Recordset
strSQL = "SELECT * FROM tblTOLabor"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
If IsNull(oRS!OptNum) Then
oRS!OptNum = 1
oRS.Update
End If
oRS.MoveNext
Loop
oRS.Close
MsgBox ("Texture Option Number is UpDated")
End Sub
Private Sub cmdYardOrder_Click()
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmYardOrder.Show 1
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub cmdNewSearch_Click()
gintLOTID = 0
gintPROJID = 0
txtSCode.Enabled = True
txtSName.Enabled = True
txtSContain.Enabled = True
txtSCode = ""
txtSName = ""
' txtSCode.Text = ""
' txtSName.Text = ""
txtSContain = ""
lstProject.Clear
lstLots.Clear
lstContains.Clear
lblProjCode.Caption = ""
lstLots.Visible = False
lblProjCode.Visible = False
lblDesc.Visible = False
cmdLotSearch.Enabled = False
cmdNewSearch.Enabled = False
cmdJCUpdate.Visible = False
cmdJCRpt.Visible = False
cmdPrintJCRpt.Visible = False
cmdTakeR.Enabled = False
mnuTake.Enabled = False
cmdOrderR.Enabled = False
mnuOrders.Enabled = False
cmdPlans.Enabled = False
mnuPlans.Enabled = False
cmdPayroll.Enabled = False
mnuPayroll.Enabled = False
cmdFCode.Enabled = False
cmdFName.Enabled = False
cmdFContain.Enabled = False
lstContains.Visible = False
lstProject.Visible = False
cmdDates.Visible = False
cmdYardOrder.Visible = False
cmdSchedule.Visible = False
cmdLotInfo.Visible = False
cmdProjNotes.Visible = False
cmdBilling.Visible = False
txtSCode.SetFocus
End Sub
Private Sub cmdPlans_Click()
cmdDates.Visible = False
cmdYardOrder.Visible = False
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
frmPlans.Show 1
End Sub
Private Sub cmdOrder_Click()
On Error GoTo Error_EH
cmdDates.Visible = False
cmdYardOrder.Visible = False
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Else
gintLOTID = 0
End If
frmLotInfo.Show 1
If gstrFLAG = "D" Then
Call cmdLotSearch_Click
End If
If gstrFLAG = "P" Then
Call cmdNewSearch_Click
End If
Exit Sub
Error_EH:
If Err = 364 Then
Exit Sub
Else
Call ErrorHandler2
Exit Sub
End If
End Sub
Private Sub cmdOrder5_Click()
On Error GoTo Error_EH
cmdDates.Visible = False
cmdYardOrder.Visible = False
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Else
gintLOTID = 0
End If
frmLotInfo5.Show 1
If gstrFLAG = "D" Then
Call cmdLotSearch_Click
End If
If gstrFLAG = "P" Then
Call cmdNewSearch_Click
End If
Exit Sub
Error_EH:
If Err = 364 Then
Exit Sub
Else
Call ErrorHandler2
Exit Sub
End If
End Sub
Private Sub cmdOrderE_Click()
On Error GoTo Error_EH
cmdDates.Visible = False
cmdYardOrder.Visible = False
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Else
gintLOTID = 0
End If
frmLotInfoE.Show 1
If gstrFLAG = "D" Then
Call cmdLotSearch_Click
End If
If gstrFLAG = "P" Then
Call cmdNewSearch_Click
End If
Exit Sub
Error_EH:
If Err = 364 Then
Exit Sub
Else
Call ErrorHandler2
Exit Sub
End If
End Sub
Private Sub cmdTake_Click()
cmdDates.Visible = False
cmdYardOrder.Visible = False
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Load frmTake
frmTake.Show 1
End Sub
Private Sub cmdTake5_Click()
cmdDates.Visible = False
cmdYardOrder.Visible = False
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Load frmTake5
frmTake5.Show 1
End Sub
Private Sub cmdTakeE_Click()
cmdDates.Visible = False
cmdYardOrder.Visible = False
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Load frmTakeE
frmTakeE.Show 1
End Sub
Private Sub Form_Load()
cmdNewSearch.Enabled = False
If gbytSECURITY = 6 Then
mnuContractor.Enabled = True
mnuProject.Enabled = True
cmdShip.Visible = True
mnuJCTrans.Enabled = True
mnuSWTRANSFER.Enabled = True
mnuAPTransfer.Enabled = True
End If
If gbytSECURITY = 7 Then
mnuContractor.Enabled = True
mnuProject.Enabled = True
mnuTransfer.Enabled = True
cmdInvoice.Visible = True
cmdShip.Visible = True
mnuJCTrans.Enabled = True
End If
If gbytSECURITY = 1 Then
mnuUser.Enabled = True
mnuRCrew.Enabled = True
mnuCrew.Enabled = True
cmdPOList.Visible = True
mnuUpCheck.Visible = True
mnuTransfer.Enabled = True
mnuJCTrans.Enabled = True
cmdInvoice.Visible = True
mnuVoid.Visible = True
mnuPosPay.Visible = True
' mnuTOI.Visible = True
cmdJCList.Visible = True
If gstrLOGIN = "DWW" Then
cmdChecks.Visible = True
cmdUpRGard.Visible = False
End If
End If
If gbytSECURITY < 3 Then
mnuSand.Enabled = True
mnuLabor.Enabled = True
mnuSupplier.Enabled = True
mnuBP.Enabled = True
mnuTexture.Enabled = True
mnuContractor.Enabled = True
mnuProject.Enabled = True
mnuInvList.Enabled = True
mnuYInvList.Enabled = True
mnuInvPrice.Enabled = True
cmdShip.Visible = True
mnuOrdersDate.Visible = True
mnuLathList.Visible = True
mnuUInv.Enabled = True
mnuSWTRANSFER.Enabled = True
mnuAPTransfer.Enabled = True
mnuProjJC.Visible = True
End If
If gbytSECURITY = 8 Or gbytSECURITY = 10 Then
mnuCrew.Enabled = True
mnuRCrew.Enabled = True
End If
If gbytSECURITY = 9 Or gbytSECURITY = 8 Then
mnuInvList.Enabled = True
mnuYInvList.Enabled = True
mnuInvPrice.Enabled = True
End If
If gbytSECURITY = 10 Then
cmdPOList.Visible = True
mnuUpCheck.Visible = True
End If
If gstrLOGIN = "TC" Then
mnuVoid.Visible = True
mnuPosPay.Visible = True
End If
If gstrLOGIN = "GK" Then
cmdJCList.Visible = True
End If
' If gstrLOGIN = "KA" Then
' cmdScaffold.Visible = False
' cmdScafList.Visible = False
' End If
End Sub
Private Function LotFind() As Boolean
Dim strSQL As String, strPlan As String, strMEMO 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
LotFind = False
Else
LotFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo - Module LotFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub lstLots_Click()
Dim strTEST As String
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
' gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Else
gintLOTID = 0
End If
If LotFind() Then
lstLots.ToolTipText = Field2Str(moRS!jobcost)
strTEST = lstLots.ToolTipText
End If
End Sub
Private Sub lstLots_DblClick()
Call cmdOrderR_Click
End Sub
Private Sub lstProject_Click()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Call FindProject
End Sub
Private Sub FixStart()
Dim oRS As Recordset
Dim strSQL As String, strSTARTDATE As String, strNEWSTART As String
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
strSQL = "SELECT * FROM tblLOTINFO WHERE Lot_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSTARTDATE = Field2Str(oRS!startdate)
strNEWSTART = InputBox("Enter The Start Date For The Highlighted Lot", "New Start Date", strSTARTDATE)
If Not IsDate(strNEWSTART) Then
MsgBox "You Entered An Invalid Date, StartDate Will Not Be Updated", vbOKOnly, "Invalid Date"
Exit Sub
Else
oRS!startdate = Str2Field(strNEWSTART)
oRS.Update
End If
End Sub
Private Sub FixPOCount()
Dim oRS As Recordset
Dim strSQL As String
Dim bytPOMAX As Byte, bytNEWMAX As Integer
strSQL = "SELECT pomax, proj_id FROM tblPROJECT WHERE proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
bytPOMAX = Field2Str2(oRS!pomax)
bytNEWMAX = Field2Str2(InputBox("Enter the New Maximum PO Count for this Project", "Update PO MAX", bytPOMAX))
If bytNEWMAX > 254 Then
MsgBox "You Entered an Invalid Number - 254 is the MAX allowed", vbOKOnly, "Update Max POCount"
Exit Sub
ElseIf bytNEWMAX = 0 Then
Exit Sub
Else
oRS!pomax = bytNEWMAX
oRS.Update
End If
End Sub
Private Sub FixPrinting()
Dim oRS As Recordset, strSQL As String
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!l_FLG = "P"
oRS!y_FLG = "P"
oRS!s_FLG = "P"
oRS!z_FLG = "P"
'***** May need to add the check box for B_FLG also.
oRS.Update
End If
End Sub
Private Sub FixBilling()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
Dim lngINVOICE As Long, lngLOTINFO As Long, strTYPE As String
Dim strDATE1 As Date, strFIND As String
strDATE1 = Date - 30
strSQL = "SELECT * FROM tblARINVOICE WHERE Header and Invoice_date >= " & strDATE1 '& "#'"
' strSQL = "SELECT * FROM tblARINVOICE WHERE Header and Invoice_date >= '#" & strDATE1 & "#'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockReadOnly
strSQLL = "SELECT * FROM tblLotInfo" ' WHERE lot_id = " & lngLOTINFO
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
Do Until oRS.EOF
lngLOTINFO = oRS!Lot_id
strTYPE = Field2Str(oRS!inv_type)
oRSS.MoveFirst
strFIND = "lot_id = " & lngLOTINFO
oRSS.Find strFIND
' If Not oRSS.EOF Then
' oRSS!notes = Field2Str(oRS!notes)
' oRSS.Update
' End If
' oRS.MoveNext
If Not oRSS.EOF Then
If strTYPE = "L" Then
If Not IsDate(oRSS!billdt_L) Then
oRSS!billdt_L = oRS!invoice_date
oRSS.Update
End If
End If
If strTYPE = "S" Or strTYPE = "C" Then
If Not IsDate(oRSS!billdt_S) Then
oRSS!billdt_S = oRS!invoice_date
oRSS.Update
End If
End If
End If
oRS.MoveNext
Loop
' MsgBox "Billing Date Update is Complete", vbOKOnly, "Update Complete"
End Sub
Private Sub FixBillingM()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
Dim lngINVOICE As Long, lngLOTINFO As Long, strTYPE As String
Dim strDATE1 As Date, strFIND As String
strDATE1 = Date - 30
strSQL = "SELECT * FROM tblARINVOICEM WHERE Header and Invoice_date >= " & strDATE1 '& "#'"
' strSQL = "SELECT * FROM tblARINVOICE WHERE Header and Invoice_date >= '#" & strDATE1 & "#'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockReadOnly
strSQLL = "SELECT * FROM tblLotInfo" ' WHERE lot_id = " & lngLOTINFO
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
Do Until oRS.EOF
lngLOTINFO = oRS!Lot_id
strTYPE = Field2Str(oRS!inv_type)
oRSS.MoveFirst
strFIND = "lot_id = " & lngLOTINFO
oRSS.Find strFIND
' If Not oRSS.EOF Then
' oRSS!notes = Field2Str(oRS!notes)
' oRSS.Update
' End If
' oRS.MoveNext
If Not oRSS.EOF Then
If strTYPE = "L" Then
If Not IsDate(oRSS!billdt_L) Then
oRSS!billdt_L = oRS!invoice_date
oRSS.Update
End If
End If
If strTYPE = "S" Or strTYPE = "C" Then
If Not IsDate(oRSS!billdt_S) Then
oRSS!billdt_S = oRS!invoice_date
oRSS.Update
End If
End If
End If
oRS.MoveNext
Loop
' MsgBox "Billing Date Update is Complete", vbOKOnly, "Update Complete"
End Sub
Private Sub FixLOTINFO()
Dim strSQL As String
Dim oRS As Recordset
strSQL = "SELECT TOID, origtoid FROM tblTAKE"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!origTOID = oRS!toid
oRS.Update
oRS.MoveNext
Loop
' End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim strSQL As String
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = vbKeyU Then 'And gbytSECURITY = 1 Then
If CtrlDown Then
If lstLots.ListIndex >= 0 Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
crMain.ReportFileName = App.Path & "\OrdChkList.rpt"
strSQL = "{tblLOTINFO.LOT_ID} = " & gintLOTID
crMain.SelectionFormula = (strSQL)
' crMain.GroupSelectionFormula = "{tblLOTINFO.LOT_ID} = " & gintLOTID
' crMain.ReplaceSelectionFormula = "{tblLOTINFO.LOT_ID} = " & gintLOTID
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.CopiesToPrinter = gintCOPY
crMain.WindowState = crptMaximized
crMain.Action = 1
crMain.Reset
End If
' MsgBox "Takeoff UpDate Complete", vbOKOnly, "Update Takeoff"
End If
Exit Sub
End If
If KeyCode = vbKeyW Then 'And gbytSECURITY = 1 Then
If CtrlDown Then
If lstLots.ListIndex >= 0 Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
crMain.ReportFileName = App.Path & "\POMatS.rpt"
strSQL = "{tblLOTINFO.LOT_ID} = " & gintLOTID
crMain.SelectionFormula = (strSQL)
' crMain.ReplaceSelectionFormula = ("{tblLOTINFO.LOT_ID} = " & gintLOTID)
' crMain.GroupSelectionFormula = "{tblLOTINFO.LOT_ID} = " & gintLOTID
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.CopiesToPrinter = gintCOPY
crMain.WindowState = crptMaximized
crMain.Action = 1
crMain.Reset
End If
' MsgBox "Takeoff UpDate Complete", vbOKOnly, "Update Takeoff"
End If
Exit Sub
End If
If KeyCode = vbKeyD Then 'And gbytSECURITY = 1 Then
If CtrlDown Then
If lstLots.ListIndex >= 0 Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
crMain.ReportFileName = App.Path & "\POMatD.rpt"
' strSQL = "{tblORDERS.LOT_ID} = " & gintLOTID & " AND {tblORDERS.M_TYPE} = 'R'"
strSQL = "{tblORDERS.LOT_ID} = " & gintLOTID '& " AND {tblORDERS.M_TYPE} = 'R'"
crMain.SelectionFormula = (strSQL)
' crMain.ReplaceSelectionFormula = "{tblLOTINFO.LOT_ID} = " & gintLOTID
' crMain.GroupSelectionFormula = "{tblLOTINFO.LOT_ID} = " & gintLOTID
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.CopiesToPrinter = gintCOPY
crMain.WindowState = crptMaximized
crMain.Action = 1
crMain.Reset
End If
' MsgBox "Takeoff UpDate Complete", vbOKOnly, "Update Takeoff"
End If
Exit Sub
End If
If KeyCode = vbKeyM And gbytSECURITY = 1 Then
If CtrlDown Then
Call FixPOCount
' MsgBox "Takeoff UpDate Complete", vbOKOnly, "Update Takeoff"
End If
Exit Sub
End If
If KeyCode = vbKeyT And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmPaySheet.Show 1
End If
Exit Sub
End If
If KeyCode = vbKeyF And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
Call FixPrinting
End If
Exit Sub
End If
If KeyCode = vbKeyS And (gbytSECURITY < 3 Or gbytSECURITY = 6) Then ' Display key combinations.
If lstLots.ListCount > 0 Then
If CtrlDown Then
Call FixStart
End If
Exit Sub
End If
End If
If KeyCode = vbKeyB And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Display key combinations.
If CtrlDown Then
Call UpStart
End If
Exit Sub
End If
End Sub
Private Sub UpStart()
Dim strEffDate As String
Dim strSQL As String, oRS As Recordset
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
strEffDate = InputBox("Enter the New Effective Date for This Project", "New Effective Date", Date)
If IsDate(strEffDate) Then
strSQL = "SELECT * FROM tblProjDate"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
oRS.AddNew
oRS!proj_id = gintPROJID
oRS!startdate = strEffDate
oRS.Update
End If
End Sub
Private Sub lstProject_DblClick()
Call cmdLotSearch_Click
End Sub
Private Sub mnuABTPosPay_Click()
Call ABTPosPay
End Sub
Private Sub mnuAck_Click()
frmAck.Show 1
End Sub
Private Sub mnuAPEdit_Click()
Dim strSQL As String, strYN As String
crMain.ReportFileName = App.Path & "\APEdit.rpt"
' crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
strYN = MsgBox("Do You Want To Print To Printer", vbYesNo, "Print?")
If strYN = vbYes Then
crMain.Destination = crptToPrinter
Else
crMain.Destination = crptToWindow
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuAREdit_Click()
Dim strSQL As String, strYN As String, strYN2 As String, strMSG As String
' cdMain.CancelError = True
cdMain.Action = 5
' If cdMain.CancelError Then
' MsgBox ("Printer Selection Canceled")
' Exit Sub
' End If
'' strMSG = "To Print A Summary Report, Click YES" & vbCrLf & vbCrLf
'' strMSG = strMSG & "To Print A Detailed Report, Click No"
'' strYN2 = MsgBox(strMSG, vbYesNo, "Select YES or NO")
crMain.ReportFileName = App.Path & "\AREdit.rpt"
'' If strYN2 = vbYes Then
'' crMain.ReportFileName = App.Path & "\ARTransSum.rpt"
'' ElseIf strYN2 = vbNo Then
'' crMain.ReportFileName = App.Path & "\ARTrans.rpt"
'' End If
strYN = MsgBox("Do You Want To Print To Printer", vbYesNo, "Print?")
If strYN = vbYes Then
crMain.Destination = crptToPrinter
Else
crMain.Destination = crptToWindow
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuBid_Click()
Dim strSQL As String
crMain.ReportFileName = App.Path & "\BidReport.rpt"
' crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuFindPO_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
gstrPONUM = UCase(InputBox("Enter The PO Number You Want (From Upper Left)", "PO Number"))
If gstrPONUM = "" Then
' MsgBox "You Must Enter A Valid VWP PO Number", vbOKOnly, "No Valid PO"
Exit Sub
End If
strSQL = "SELECT PONum, Lot_ID FROM tblOrders WHERE ponum = " & Int(gstrPONUM) ' & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
gintLOTID = Field2Long(oRS!Lot_id)
' gintLOTID = Field2Integer(oRS!Lot_id)
strSql2 = "SELECT lot_id, proj_id FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
gintPROJID = Field2Long(oRSS!proj_id)
' gintPROJID = Field2Integer(oRSS!proj_id)
End If
Else
MsgBox "You Must Enter A Valid VWP PO Number", vbOKOnly, "No Valid PO"
Exit Sub
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
' gintORDER = 8
gintORDER = 9
frmOrders.Show 1
End Sub
Private Sub mnuFIXAP_Click()
frmAPFIX.Show 1
End Sub
Private Sub mnuFIXAR_Click()
frmARFIX.Show 1
End Sub
Private Sub mnuFoamOrder_Click()
frmFoam.Show 1
End Sub
Private Sub mnuJCTrans_Click()
Dim strSQL As String, intYN As Integer
intYN = MsgBox("Are You Sure You Want Clear The Job Cost File for VWP?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
strSQL = "DELETE * FROM tblJCTrans"
goConn.Execute strSQL
MsgBox "VWP Job Cost Transfer Is Complete", vbOKOnly, "Job Cost"
End Sub
Private Sub mnuJPPosPay_Click()
Call BOPosPay
End Sub
Private Sub mnuMAPEdit_Click()
Dim strSQL As String, strYN As String
crMain.ReportFileName = App.Path & "\APEditM.rpt"
' crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
strYN = MsgBox("Do You Want To Print To Printer", vbYesNo, "Print?")
If strYN = vbYes Then
crMain.Destination = crptToPrinter
Else
crMain.Destination = crptToWindow
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuMAREdit_Click()
Dim strSQL As String, strYN As String
crMain.ReportFileName = App.Path & "\AREditM.rpt"
' crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
strYN = MsgBox("Do You Want To Print To Printer", vbYesNo, "Print?")
If strYN = vbYes Then
crMain.Destination = crptToPrinter
Else
crMain.Destination = crptToWindow
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuMJCTrans_Click()
Dim strSQL As String, intYN As Integer
intYN = MsgBox("Are You Sure You Want Clear The Job Cost File for Metro Stucco?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
strSQL = "DELETE * FROM tblJCTransM"
goConn.Execute strSQL
MsgBox "Metro Stucco Job Cost Transfer Is Complete", vbOKOnly, "Job Cost"
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show
End Sub
Private Sub mnuARUPDATE_Click()
Dim strSQL As String, strSELECT As String, strTEST As String
Dim oRS As Recordset, oRSS As Recordset
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strTEST = "DELETE * FROM tblARMASTER"
goConn.Execute strTEST
frmMain.MousePointer = vbHourglass
strSQL = "SELECT * FROM AR1_CustomerMaster WHERE SORTFIELD <> '99'"
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
If Trim(oRS!SortField) = "99" Then
Else
Do Until oRS.EOF
strSELECT = "SELECT * FROM tblARMaster WHERE Cust_NO = '" & oRS!CustomerNumber & "'"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRSS.EOF Then
oRSS.AddNew
oRSS!Division = Field2Str(oRS!Division)
oRSS!cust_no = Field2Str(oRS!CustomerNumber)
oRSS!Name = Field2Str(oRS!customername)
oRSS!address1 = Field2Str(oRS!addressline1)
oRSS!address2 = Field2Str(oRS!addressline2)
' oRSS!address2 = Trim$(field2str(oRS!addressline2))
oRSS!city = Field2Str(oRS!city)
oRSS!State = Field2Str(oRS!State)
oRSS!zipcode = Left(Field2Str(oRS!zipcode), 5)
oRSS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
End If
frmMain.MousePointer = vbArrow
MsgBox "AR Master file update is complete"
End Sub
Private Sub mnuAPUPDATE_Click()
Dim strSQL As String, strSELECT As String, strTEST As String
Dim oRS As Recordset, oRSS As Recordset
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strTEST = "DELETE * FROM tblAPMASTER"
goConn.Execute strTEST
frmMain.MousePointer = vbHourglass
strSQL = "SELECT * FROM AP1_VendorMaster WHERE SORTFIELD <> '99'"
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
If Trim(oRS!SortField) = "99" Then
Else
Do Until oRS.EOF
strSELECT = "SELECT * FROM tblAPMaster WHERE Cust_NO = """ & oRS!VendorNumber & """"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRSS.EOF Then
oRSS.AddNew
oRSS!Division = Field2Str(oRS!Division)
oRSS!cust_no = Field2Str(oRS!VendorNumber)
oRSS!Name = Field2Str(oRS!VendorName)
oRSS!address1 = Field2Str(oRS!addressline1)
oRSS!address2 = Field2Str(oRS!addressline2)
' oRSS!address2 = Trim$(field2str(oRS!addressline2))
oRSS!city = Field2Str(oRS!city)
oRSS!State = Field2Str(oRS!State)
oRSS!zipcode = Left(Field2Str(oRS!zipcode), 5)
oRSS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
End If
frmMain.MousePointer = vbArrow
MsgBox "AP Master file update is complete"
End Sub
Private Sub mnuBP_Click()
frmBlackPaper.Show
End Sub
Private Sub mnuContractor_Click()
frmContractor.Show
End Sub
Private Sub mnuCrew_Click()
frmCrews.Show
End Sub
Private Sub mnuCrews_Click()
Dim strSQL As String, strSELECT As String, strFIND As String
Dim oRS As Recordset, oRSS As Recordset
frmMain.MousePointer = vbHourglass
strSQL = "SELECT * FROM tblTime"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strSELECT = "SELECT Crew_id, Old_id, type FROM tblCrew WHERE type = '" & oRS!pay_type & "' and Old_id = " & oRS!crew
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
oRS!crew = Field2Str(oRSS!crew_id)
oRS.Update
Else
oRS!crew = 0
oRS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
frmMain.MousePointer = vbArrow
MsgBox "Crew conversion is complete"
End Sub
Private Sub mnuEstInv_Click()
frmInvTake.Show 1
End Sub
Private Sub mnuInvCount_Click()
crMain.ReportFileName = App.Path & "\InventoryReport.rpt"
crMain.Destination = crptToPrinter
crMain.Action = 1
End Sub
Private Sub mnuNotes_Click()
Dim strSQL As String, strSELECT As String, strFIND As String
Dim oRS As Recordset, oRSS As Recordset
frmMain.MousePointer = vbHourglass
strSQL = "SELECT lot_id, notes FROM lotnote ORDER BY lot_id"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSELECT = "SELECT lot_id, notes FROM tblLotInfo"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.MoveFirst
strFIND = "lot_id = " & oRS!Lot_id
oRSS.Find strFIND
If Not oRSS.EOF Then
oRSS!notes = Field2Str(oRS!notes)
oRSS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
strSQL = "SELECT toid, notes FROM takenote ORDER BY toid"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSELECT = "SELECT toid, notes FROM tblTake"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.MoveFirst
strFIND = "toid = " & oRS!toid
oRSS.Find strFIND
If Not oRSS.EOF Then
oRSS!notes = Field2Str(oRS!notes)
oRSS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
strSQL = "SELECT est_id, notes FROM plannote ORDER BY est_id"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSELECT = "SELECT est_id, notes FROM tblplans"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.MoveFirst
strFIND = "est_id = " & oRS!est_id
oRSS.Find strFIND
If Not oRSS.EOF Then
oRSS!notes = Field2Str(oRS!notes)
oRSS.Update
End If
oRS.MoveNext
Loop
oRSS.Close
oRS.Close
frmMain.MousePointer = vbArrow
MsgBox "Notes conversion is complete"
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuFixTOM_Click()
Dim strSQL As String, strSql2 As String, strSQL3 As String
Dim oRS As Recordset, oRSS As Recordset
Dim strID As String
strSQL = "SELECT * FROM tblCrewList" ' where Order_date > #12/31/2001#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' strSql2 = "SELECT * FROM tblLotInfo" ' where proj_id = " & Field2Integer(oRS!proj_id) & " and pln_elv = '" & Field2Str(oRS!mod_elv) & "'"
' Set oRSS = New Recordset
' oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strID = oRS!emp_id
strSql2 = "SELECT Department, EmployeeNumber, LastName, FirstName, DefaultWCCode FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strID & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
' strSQL3 = "lot_id = " & Field2Integer(oRS!Lot_id) ' & " and pln_elv = '" & Field2Str(oRS!mod_elv) & "'"
' oRSS.BOF
' oRSS.Filter = strSQL3
If Not oRSS.EOF Then
'With oRSS
oRS!wc_code = Field2Str(oRSS!defaultwccode) ' * Field2Str(!openpr)) / 100) + 0.99)
oRS.Update
'End With
'oRSS.MoveFirst
End If
' oRSS.MoveFirst
oRS.MoveNext
Loop
MsgBox "The WCCode Update is Complete"
End Sub
Private Sub mnuLathList_Click()
Dim strSELECT As String
On Error GoTo Error_EH
gintPRINT = 9
frmReport.Show 1
crMain.ReportFileName = App.Path & "\LathOrderDateList.rpt"
crMain.GroupSelectionFormula = strSELECT
crMain.CopiesToPrinter = gintCOPY
crMain.Destination = gintDEST
crMain.WindowState = crptMaximized
crMain.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module mnuOrdersDate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub mnuMAPTransfer_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The AP Transfer for Metro Stucco?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupMAPTransfer
End Sub
Private Sub mnuMARUpdate_Click()
Dim strSQL As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
frmMain.MousePointer = vbHourglass
strSQL = "SELECT * FROM AR1_CustomerMaster"
Set oRS = New Recordset
oRS.Open strSQL, goConn3, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strSELECT = "SELECT * FROM tblARMasterM WHERE Cust_NO = '" & oRS!CustomerNumber & "'"
Set oRSS = New Recordset
oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRSS.EOF Then
oRSS.AddNew
oRSS!Division = Field2Str(oRS!Division)
oRSS!cust_no = Field2Str(oRS!CustomerNumber)
oRSS!Name = Field2Str(oRS!customername)
oRSS!address1 = Field2Str(oRS!addressline1)
oRSS!address2 = Field2Str(oRS!addressline2)
' oRSS!address2 = Trim$(field2str(oRS!addressline2))
oRSS!city = Field2Str(oRS!city)
oRSS!State = Field2Str(oRS!State)
oRSS!zipcode = Left(Field2Str(oRS!zipcode), 5)
oRSS.Update
End If
oRS.MoveNext
Loop
' oRSS.Close
' oRS.Close
frmMain.MousePointer = vbArrow
MsgBox "Metro Stucco AR Master file update is complete"
End Sub
Private Sub mnuOrder5_Click()
cmdOrderR.Caption = "Orders PreMix"
mnuOrder5.Checked = True
mnuOrderR.Checked = False
mnuOrderE.Checked = False
End Sub
Private Sub mnuOrderE_Click()
cmdOrderR.Caption = "Orders Synthetic"
mnuOrder5.Checked = False
mnuOrderR.Checked = False
mnuOrderE.Checked = True
End Sub
Private Sub mnuOrderR_Click()
cmdOrderR.Caption = "Orders"
mnuOrder5.Checked = False
mnuOrderR.Checked = True
mnuOrderE.Checked = False
End Sub
Private Sub mnuPayroll_Click()
Call cmdPayroll_Click
End Sub
Private Sub mnuPlanUse_Click()
Dim strSQL As String
If lstProject.ListIndex = -1 Then
MsgBox "You Need To Select A Project First", vbOKOnly, "No Project"
Exit Sub
End If
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
crMain.GroupSelectionFormula = "{tblLOTINFO.PROJ_ID} = " & gintPROJID
crMain.ReportFileName = App.Path & "\PlanUsage.rpt"
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuPOList_Click()
frmPOList.Show 1
End Sub
Private Sub mnuPOListdesc_Click()
Dim strSQL As String, strYN As String
crMain.ReportFileName = App.Path & "\POListDescend.rpt"
' crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
strYN = MsgBox("Do You Want To Print To Printer", vbYesNo, "Print?")
If strYN = vbYes Then
crMain.Destination = crptToPrinter
Else
crMain.Destination = crptToWindow
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub BOPosPay()
Dim strEXPORT As String * 66, strSQL As String, strSql2 As String
Dim strCHECK As String * 6, strAMT As String * 13
Dim strDate As String * 8, strName As String * 30
Dim oRS As Recordset, strFile As String, strMSG As String
Dim strBegDate As String, strEndDate As String
Dim intCount As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
' strBANK = InputBox("Enter the Bank Code you want to Export", "Bank Code", "4")
strBANK = "4"
strBegDate = InputBox("Enter the Beginning Date (MM/DD/YY)", "Beginning Date")
strEndDate = InputBox("Enter the Ending Date (MM/DD/YY)", "Ending Date", strBegDate)
MousePointer = 11
strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
strName = Space(30)
strFile = "C:\BankOne\PosPay.txt"
intCount = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CheckTransDate, "MM/DD/YY")
strAMT = Format(Field2Str(!amount), "#.00")
strCHECK = Format(!CheckNumber, "000000")
strName = Field2Str(!CheckPayeeName)
strEXPORT = "06279209" & strDate & strCHECK & strAMT & strName
If strDate >= strBegDate And strDate <= strEndDate Then
intCount = intCount + 1
dblTotal = dblTotal + Field2Str2(!amount)
Print #1, strEXPORT
End If
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File has been Created With" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & intCount & " Checks And A Total Of " & Format(dblTotal, "#,#.00")
MsgBox strMSG, vbOKOnly, "Export File Ready"
Close #1
MousePointer = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module BOPosPay"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub ABTPosPay()
Dim strEXPORT As String * 80, strSQL As String, strSql2 As String
Dim strCHECK As String * 10, strAMT As String * 10, strSTART As String
Dim strDate As String * 6, strName As String * 34
Dim oRS As Recordset, strFile As String, strMSG As String
Dim strBegDate As String, strEndDate As String
Dim strBegDate2 As String, strEndDate2 As String
Dim intCount As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
' strBANK = InputBox("Enter the Bank Code you want to Export", "Bank Code", "4")
' strBANK = "5"
strBANK = "7"
strBegDate = InputBox("Enter the Beginning Date (MM/DD/YY)", "Beginning Date")
strEndDate = InputBox("Enter the Ending Date (MM/DD/YY)", "Ending Date", strBegDate)
MousePointer = 11
strBegDate2 = Format(strBegDate, "MMDDYY")
strEndDate2 = Format(strEndDate, "MMDDYY")
strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "Did not open bank code", vbOKOnly
Exit Sub
End If
strName = Space(34)
strFile = "C:\AZBank\PosPay.txt"
intCount = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CheckTransDate, "MMDDYY")
strAMT = Format(Field2Str(!amount), "0000000.00")
strCHECK = Format(!CheckNumber, "0000000000")
' strName = Field2Str(!CheckPayeeName)
strEXPORT = "C007009361130919 RA " & strCHECK & strAMT & strDate & strName
If strDate >= strBegDate2 And strDate <= strEndDate2 Then
intCount = intCount + 1
dblTotal = dblTotal + Field2Str2(!amount)
Print #1, strEXPORT
End If
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File has been Created With" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & intCount & " Checks And A Total Of " & Format(dblTotal, "#,#.00")
MsgBox strMSG, vbOKOnly, "Export File Ready"
Close #1
MousePointer = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module BOPosPay"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub WFPosPay()
'Dim strEXPORT As String * 66, strSQL As String, strSql2 As String
Dim strEXPORT As String, strSQL As String, strSql2 As String
'Dim strCHECK As String * 6, strAMT As String * 13
Dim strCHECK As String, strAMT As String
'Dim strDate As String * 8, strName As String * 30
Dim strDate As String, strName As String
Dim oRS As Recordset, strFile As String
Dim strBegDate As String, strEndDate As String
Dim intCount As Integer, dblTotal As Double, strBANK As String
Dim strRTN, strACCT, strTYPE, strMSG As String
Dim lngRTN, lngTYPE As Long
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
' strBANK = InputBox("Enter the Bank Code you want to Export", "Bank Code", "4")
strBANK = "5"
strMSG = "Enter the Beginning Date (MMDDYYYY)"
strBegDate = InputBox(strMSG, "Beginning Date")
If IsDate(strBegDate) Then
Else
If Len(strBegDate) > 0 Then
strBegDate = Format(strBegDate, "00-00-####")
If Not IsDate(strBegDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date"
Exit Sub
End If
End If
End If
strMSG = "Enter the Ending Date (MMDDYYYY)"
strEndDate = InputBox(strMSG, "Ending Date", strBegDate)
If IsDate(strEndDate) Then
Else
If Len(strEndDate) > 0 Then
strEndDate = Format(strEndDate, "00-00-####")
If Not IsDate(strEndDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date"
Exit Sub
End If
End If
End If
' strBegDate = InputBox("Enter the Beginning Date (MM-DD-YYYY)", "Beginning Date")
' strEndDate = InputBox("Enter the Ending Date (MM-DD-YYYY)", "Ending Date", strBegDate)
MousePointer = 11
lngRTN = 122105278
'* strRTN = "122105278"
strACCT = "6861290531"
lngTYPE = 320
'* strTYPE = "320"
strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
strName = Space(30)
strFile = "C:\WellsFargo\PosPay.csv"
intCount = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CheckTransDate, "MM-DD-YYYY")
strAMT = Format(Field2Str(!amount), "#.00")
strCHECK = Format(!CheckNumber, "000000")
' strName = Field2Str(!CheckPayeeName)
'** strDate = "06-29-2013"
'** strAMT = "1250.00"
'** strCHECK = "123456"
strEXPORT = lngRTN & "," & strACCT & "," & strCHECK & "," & strDate & "," & strAMT & "," & lngTYPE
'** strEXPORT = strRTN & "," & strACCT & "," & strDate & "," & strCHECK & "," & strAMT & "," & strTYPE
If strDate >= strBegDate And strDate <= strEndDate Then
intCount = intCount + 1
dblTotal = dblTotal + Field2Str2(strAMT)
' dblTotal = dblTotal + Field2Str2(!amount)
Print #1, strEXPORT
End If
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File has been Created With" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & intCount & " Checks And A Total Of " & Format(dblTotal, "#,#.00")
MsgBox strMSG, vbOKOnly, "Export File Ready"
Close #1
MousePointer = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module WFPosPay"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub mnuPosPayHold_Click()
Dim strEXPORT As String * 66, strSQL As String, strSql2 As String
Dim strCHECK As String * 6, strAMT As String * 13
Dim strDate As String * 8, strName As String * 30
Dim oRSP As Recordset, strSQLP As String
Dim oRSP2 As Recordset, strSQLP2 As String
Dim oRS As Recordset, strFile As String, strMSG As String
Dim strBegDate As String, strEndDate As String
Dim intCount As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strBANK = InputBox("Enter the Bank Code you want to Export", "Bank Code", "4")
' strBegDate = InputBox("Enter the Beginning Date (MM/DD/YY)", "Beginning Date")
' strEndDate = InputBox("Enter the Ending Date (MM/DD/YY)", "Ending Date", strBegDate)
mstrBegDate = InputBox("Enter the Beginning Date (MM/DD/YY)", "Beginning Date")
mstrEndDate = InputBox("Enter the Ending Date (MM/DD/YY)", "Ending Date", mstrBegDate)
MousePointer = 11
strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
'' strSQLP = "SELECT * FROM PR_23PerptHistoryDetail WHERE CheckNumber = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
'' Set oRS = New Recordset
'' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
'' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
'' Set oRS = New Recordset
'' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
strName = Space(30)
strFile = "C:\BankOne\PosPay.txt"
intCount = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CheckTransDate, "MM/DD/YY")
strAMT = Format(Field2Str(!amount), "#.00")
strCHECK = Format(!CheckNumber, "000000")
strName = Field2Str(!CheckPayeeName)
strEXPORT = "06279209" & strDate & strCHECK & strAMT & strName
If strDate >= strBegDate And strDate <= strEndDate Then
intCount = intCount + 1
dblTotal = dblTotal + Field2Str2(!amount)
Print #1, strEXPORT
End If
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File has been Created With" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & intCount & " Checks And A Total Of " & Format(dblTotal, "#,#.00")
MsgBox strMSG, vbOKOnly, "Export File Ready"
Close #1
MousePointer = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module mnuPosPay"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub mnuPosPay2_Click()
Dim strEXPORT As String * 66, strSQL As String, strSql2 As String
Dim strCHECK As String * 6, strAMT As String * 13
Dim strDate As String * 8, strName As String * 30
Dim oRS As Recordset, strFile As String, strMSG As String
Dim strBegDate As String, strEndDate As String
Dim intCount As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strBANK = InputBox("Enter the Bank Code you want to Export", "Bank Code", "4")
strBegDate = InputBox("Enter the Beginning Date (MM/DD/YY)", "Beginning Date")
strEndDate = InputBox("Enter the Ending Date (MM/DD/YY)", "Ending Date", strBegDate)
MousePointer = 11
strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '" & strBANK & "' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
' strSQL = "SELECT * FROM BR1_Transaction WHERE TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
strName = Space(30)
strFile = "C:\BankOne\PosPay.txt"
intCount = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CheckTransDate, "MM/DD/YY")
strAMT = Format(Field2Str(!amount), "#.00")
strCHECK = Format(!CheckNumber, "000000")
strName = Field2Str(!CheckPayeeName)
strEXPORT = "06279209" & strDate & strCHECK & strAMT & strName
If strDate >= strBegDate And strDate <= strEndDate Then
intCount = intCount + 1
dblTotal = dblTotal + Field2Str2(!amount)
Print #1, strEXPORT
End If
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File has been Created With" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & intCount & " Checks And A Total Of " & Format(dblTotal, "#,#.00")
MsgBox strMSG, vbOKOnly, "Export File Ready"
Close #1
MousePointer = 0
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module mnuPosPay"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub mnuProjJC_Click()
Dim strYN As String
If lstProject.ListIndex = -1 Then
MsgBox "You Need To Select A Project First", vbOKOnly, "No Project"
Exit Sub
End If
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
strYN = MsgBox("Do You Want To Print to the Printer", vbYesNo, "Print to Printer")
crMain.ReportFileName = App.Path & "\JCSummary.rpt"
crMain.ReplaceSelectionFormula "{tblPROJECT.PROJ_ID} = " & gintPROJID & " and {tblLOTINFO.BILL}>0"
If strYN = vbNo Then
crMain.Destination = crptToWindow
Else
crMain.Destination = crptToPrinter
End If
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuProjPlan_Click()
Dim strSQL As String
If lstProject.ListIndex = -1 Then
MsgBox "You Need To Select A Project First", vbOKOnly, "No Project"
Exit Sub
End If
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
crMain.ReportFileName = App.Path & "\PlansInfo.rpt"
crMain.ReplaceSelectionFormula "{tblPLANS.PROJ_ID} = " & gintPROJID
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuRCrew_Click()
frmRCrew.Show
End Sub
Private Sub mnuInvList_Click()
' frmInventory.Load
frmInventory.Show
End Sub
Private Sub mnuRepList_Click()
frmRepList.Show 1
End Sub
Private Sub mnuSand_Click()
frmSand.Show
End Sub
Private Sub mnuSCrew_Click()
frmSCrew.Show
End Sub
Private Sub mnuSetupSWMAR_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The SW AR Transfer for Metro Stucco?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupARMTransfer
MsgBox "SW Accounts Receivable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
End Sub
Private Sub mnuTake5_Click()
cmdTakeR.Caption = "Takeoff PreMix"
mnuTake5.Checked = True
mnuTakeR.Checked = False
mnuTakeE.Checked = False
End Sub
Private Sub mnuTakeE_Click()
cmdTakeR.Caption = "Takeoff Synthetic"
mnuTakeE.Checked = True
mnuTake5.Checked = False
mnuTakeR.Checked = False
End Sub
Private Sub mnuTakeR_Click()
cmdTakeR.Caption = "Takeoff"
mnuTakeR.Checked = True
mnuTake5.Checked = False
mnuTakeE.Checked = False
End Sub
Private Sub mnuTransfer_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The AR Transfer?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupTransfer
MsgBox "Accounts Receivable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
End Sub
Private Sub mnuMARTransfer_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The AR Transfer for Metro Stucco?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupMARTransfer
MsgBox "Metro Stucco Accounts Receivable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
End Sub
Private Sub mnuSWTransfer_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The SW AR Transfer?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupARTransfer
MsgBox "SW Accounts Receivable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
End Sub
Private Sub mnuAPTransfer_Click()
Dim intYN As Integer
intYN = MsgBox("Are You Sure You Are Ready To Setup The AP Transfer?", vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupAPTransfer
End Sub
Private Sub mnuUInv_Click()
Dim intTAKE As Integer, intPLAN As Integer, intLOT As Integer
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSql2 As String
intTAKE = MsgBox("This will take as much as 10 minutes per file - Do You Want To Continue?", vbQuestion + vbYesNo + 256, "Just Do It")
If intTAKE <> 6 Then
Exit Sub
End If
intTAKE = MsgBox("Do You Want to Update Takeoff Inventory?", vbYesNo + 256, "Takeoff Inventory")
intPLAN = MsgBox("Do You Want to Update Plan Inventory?", vbYesNo + 256, "Plans Inventory")
intLOT = MsgBox("Do You Want to Update Lot Orders Inventory?", vbYesNo + 256, "Lot Orders Inventory")
strSQL = "SELECT * FROM tblINVTRY"
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
If intTAKE = 6 Then
MousePointer = vbHourglass
frmMain.Enabled = False
oRSS.MoveFirst
Do While Not oRSS.EOF
strSql2 = "UPDATE tblTOMatrl set d_flag = '" & oRSS!d_flag & "', m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
' strSQL2 = "UPDATE tblTOMatrl set d_flag = '" & oRSS!d_flag & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
' strSQL2 = "UPDATE tblTOMatrl set m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
' goConn.Execute strSQL2
strSql2 = "UPDATE tblOPTMatrl set d_flag = '" & oRSS!d_flag & "', m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
' strSQL2 = "UPDATE tblOPTMatrl set d_flag = '" & oRSS!d_flag & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
' strSQL2 = "UPDATE tblOPTMatrl set m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
' goConn.Execute strSQL2
oRSS.MoveNext
Loop
MousePointer = vbArrow
frmMain.Enabled = True
MsgBox "TakeOff Material Has Been Updated", vbOKOnly, "Update Complete"
End If
If intPLAN = 6 Then
MousePointer = vbHourglass
frmMain.Enabled = False
oRSS.MoveFirst
Do While Not oRSS.EOF
strSql2 = "UPDATE tblPlanMat set d_flag = '" & oRSS!d_flag & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
strSql2 = "UPDATE tblPlanMat set m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
strSql2 = "UPDATE tblPOMatrl set d_flag = '" & oRSS!d_flag & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
strSql2 = "UPDATE tblPOMatrl set m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
oRSS.MoveNext
Loop
MousePointer = vbArrow
frmMain.Enabled = True
MsgBox "Plan Material Has Been Updated", vbOKOnly, "Update Complete"
End If
If intLOT = 6 Then
MousePointer = vbHourglass
frmMain.Enabled = False
oRSS.MoveFirst
Do While Not oRSS.EOF
strSql2 = "UPDATE tblLOTMatrl set d_flag = '" & oRSS!d_flag & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
strSql2 = "UPDATE tblLOTMatrl set m_type = '" & oRSS!m_type & "' WHERE inv_no = " & oRSS!inv_no
goConn.Execute strSql2
oRSS.MoveNext
Loop
MousePointer = vbArrow
frmMain.Enabled = True
MsgBox "Lot Order Material Has Been Updated", vbOKOnly, "Update Complete"
End If
End If
End Sub
Private Sub mnuUpCheck_Click()
Dim strPayDate As String, strMSG As String
Dim strSQL As String, strSql2 As String, strSQL3 As String, strSQL4 As String, strSQL5 As String
Dim oRS As Recordset, oRSC As Recordset, oRST As Recordset, oRSCH As Recordset
Dim strRDate As String
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strMSG = "Enter the Payroll Date to Process (MM/DD/YYYY)" & vbCrLf
strMSG = strMSG & "If you have not exported the check information" & vbCrLf
strMSG = strMSG & "from MAS90, then EXIT and do it before processing!!"
strPayDate = InputBox(strMSG, "Process Checks")
If IsDate(strPayDate) Then
strSQL5 = "SELECT Department, EmployeeNumber, CheckDate, CheckNumber FROM PR5_CheckHistory " 'WHERE PR5_CheckHistory.CheckDate = '04/20/2001'" '& strPayDate '& "'"
Set oRSCH = New Recordset
oRSCH.Open strSQL5, goConn2, adOpenForwardOnly, adLockReadOnly
If oRSCH.RecordCount = 0 Then
MsgBox "There Were No Checks Found In The MAS90 Check File", vbOKOnly, "NO CHECKS"
Exit Sub
End If
strSQL = "SELECT Crew_id, Pay_id FROM tblPayHeader WHERE Pay_date = #" & Field2Str(strPayDate) & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
strSql2 = "SELECT Empno FROM tblCREW WHERE crew_id = " & Field2Str2(oRS!crew_id)
Set oRSC = New Recordset
oRSC.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If IsNull(oRSC!empno) Or oRSC!empno = "0000000" Then
strMSG = "No Employee Number was found for crew # " & Field2Str(oRS!crew_id)
strMSG = strMSG & vbCrLf & "Add the Employee Number and ReProcess Checks"
MsgBox strMSG, vbOKOnly, "No Employee Number"
Exit Sub
End If
strSQL3 = "EmployeeNumber = '" & Field2Str(oRSC!empno) & "' AND CheckDate = '" & strPayDate & "'"
' strSQL3 = "EmployeeNumber = '" & Field2Str(oRSC!empno) & "'"
oRSCH.Filter = strSQL3
' Set oRSCH = New Recordset
' oRSCH.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If oRSCH.EOF Then
strMSG = "No Check Was Found For Employee Number " & Field2Str(oRSC!empno)
strMSG = strMSG & vbCrLf & "Check to See Why There is No Check and ReProcess Checks"
MsgBox strMSG, vbOKOnly, "No Check"
Exit Sub
Else
strSQL4 = "UPDATE tblTIME SET prcheck = '" & Field2Str(oRSCH!CheckNumber) & "' WHERE pay_id = " & Field2Str(oRS!pay_id)
goConn.Execute strSQL4
strSQL4 = "UPDATE tblTIME SET prdate = '" & Field2Str(strPayDate) & "' WHERE pay_id = " & Field2Str(oRS!pay_id)
goConn.Execute strSQL4
End If
oRS.MoveNext
Loop
Else
MsgBox "The Date You Entered Is Invalid -- ReEnter", vbOKOnly, "Invalid Date"
Exit Sub
End If
MsgBox "Check Number Update Is Complete", vbOKOnly, "UPDATE CHECKS"
crMain.ReportFileName = App.Path & "\PRCheckList.rpt"
crMain.CopiesToPrinter = 1
strRDate = Format(strPayDate, "yyyy,mm,dd")
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.ParameterFields(0) = "StartDate;date(" & strRDate & ");TRUE"
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuVoid_Click()
Dim intResponse As Integer
crMain.ReportFileName = App.Path & "\VoidCk.rpt"
intResponse = MsgBox("Do You Want to View the Report Instead of Printing?", vbYesNo, "Print Where?")
If intResponse = vbYes Then
crMain.Destination = crptToWindow
Else
crMain.Destination = crptToPrinter
End If
crMain.CopiesToPrinter = 1
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuWFPosPay_Click()
Call WFPosPay
End Sub
Private Sub mnuYInvList_Click()
frmYInventory.Show
End Sub
Private Sub mnuInvPrice_Click()
frmInvPrice.Show
End Sub
Private Sub mnuLabor_Click()
frmLabor.Show
End Sub
Private Sub mnuOrders_Click()
Call cmdOrder_Click
End Sub
Private Sub mnuOrdersDate_Click()
Dim strSELECT As String
On Error GoTo Error_EH
gintPRINT = 9
frmReport.Show 1
crMain.ReportFileName = App.Path & "\TextureOrderDateList.rpt"
crMain.GroupSelectionFormula = strSELECT
crMain.CopiesToPrinter = gintCOPY
crMain.Destination = gintDEST
crMain.WindowState = crptMaximized
crMain.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module mnuOrdersDate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub mnuPlans_Click()
Call cmdPlans_Click
End Sub
Private Sub cmdLotSearch_Click()
lstLots.Width = 6000
lstLots.Visible = True
lstProject.Width = 2595
Call LotLoad
cmdJCUpdate.Visible = True
cmdNewSearch.Enabled = True
cmdYardOrder.Visible = True
cmdSchedule.Visible = True
cmdLotInfo.Visible = True
cmdPOInfo.Visible = True
cmdScaffold.Visible = True
If gbytSECURITY < 10 Then
cmdOrderR.Enabled = True
mnuOrders.Enabled = True
cmdDates.Visible = True
End If
If gbytSECURITY = 8 Or gbytSECURITY = 1 Or gbytSECURITY = 10 Or gstrLOGIN = "TYF" Then
cmdPayroll.Enabled = True
mnuPayroll.Enabled = True
End If
If gbytSECURITY < 3 Then
cmdTakeR.Enabled = False
mnuTake.Enabled = False
cmdJCRpt.Visible = True
cmdPrintJCRpt.Visible = True
End If
If gbytSECURITY < 7 Then
cmdPlans.Enabled = False
mnuPlans.Enabled = False
End If
' If gstrLOGIN = "KA" Then
' cmdScaffold.Visible = False
' cmdScafList.Visible = False
' End If
If gstrLOGIN = "AOB" Or gstrLOGIN = "CKW" Then
cmdPlans.Enabled = False
mnuPlans.Enabled = False
End If
lstLots.SetFocus
End Sub
Private Sub cmdFCode_Click()
If Len(txtSCode) > 0 Then
txtSCode.Enabled = False
txtSName.Enabled = False
Call CodeLoad
Else
MsgBox "A Project Code Must Be Entered", , "No Project Code"
txtSCode.SetFocus
End If
cmdOrderR.Enabled = False
mnuOrders.Enabled = False
If mboolSHOW Then
cmdLotSearch.Enabled = True
cmdProjNotes.Visible = True
If gbytSECURITY < 3 Then
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gstrLOGIN = "CKW" Then
' ElseIf gstrLOGIN = "AOB" Or gstrLOGIN = "CKW" Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 6 Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 7 Then
cmdBilling.Visible = True
End If
lstProject.SetFocus
Else
txtSCode.SetFocus
End If
End Sub
Private Sub cmdFName_Click()
If Len(txtSName) > 0 Then
txtSCode.Enabled = False
txtSName.Enabled = False
Call NameLoad
Else
MsgBox "A Project Name Must Be Entered", , "No Project Name"
txtSName.SetFocus
End If
cmdOrderR.Enabled = False
mnuOrders.Enabled = False
If mboolSHOW Then
cmdLotSearch.Enabled = True
cmdProjNotes.Visible = True
If gbytSECURITY < 3 Then
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gstrLOGIN = "CKW" Then
' ElseIf gstrLOGIN = "AOB" Or gstrLOGIN = "CKW" Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 6 Then
cmdPlans.Enabled = True
mnuPlans.Enabled = True
cmdTakeR.Enabled = True
mnuTake.Enabled = True
cmdBilling.Visible = True
ElseIf gbytSECURITY = 7 Then
cmdBilling.Visible = True
End If
lstProject.SetFocus
Else
txtSName.SetFocus
End If
End Sub
Private Sub ContainLoad()
Dim oRS As Recordset, oRSP As Recordset
Dim strSQL As String, strSELECT As String, strContain As String
Dim strSQLP As String, intYN As Integer, strADDRESS As String, strLine As String
Dim strProj_Desc As String, strProj_Cont As String, strProj_Code As String
mboolSHOW = False
lstContains.Visible = True
lstContains.Left = 60
lstContains.Height = 4815
lstContains.Top = 3600
lstContains.Width = 11775
lstContains.Clear
DoEvents
lstLots.Visible = False
lstProject.Visible = False
lblProjCode.Visible = False
' lblProjCode.Visible = True
' lblDesc.Visible = True
' lstContains.Clear
strContain = Trim$(txtSContain.Text)
' strSELECT = "Lot_ID,Proj_ID, Lot_No, Address FROM tblLOTINFO"
' strSELECT = "Lot_ID,Proj_ID, Lot_No, Address FROM tblLOTINFO"
strSQL = "SELECT Lot_ID, Proj_ID, Lot_No, Address FROM tblLOTINFO"
' strSQLP = "SELECT Proj_id, Proj_desc, proj_code FROM tblProject "
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
If Len(oRS!address) = 0 Then '1
intYN = 0
Else
strADDRESS = Field2Str(oRS!address)
intYN = InStr(1, UCase(Trim(strADDRESS)), UCase(Trim(txtSContain))) ', vbTextCompare)
End If
If intYN > 0 Then
strSQLP = "SELECT Proj_ID, Proj_Desc, Proj_Cont, Proj_Code FROM tblPROJECT WHERE Proj_ID = " & Field2Str2(oRS!proj_id)
Set oRSP = New Recordset
oRSP.Open strSQLP, goConn, adOpenKeyset, adLockOptimistic
If Not oRSP.EOF Then
strProj_Desc = Field2Str(oRSP!proj_desc)
strProj_Cont = Field2Str(oRSP!proj_cont)
strProj_Code = Field2Str(oRSP!proj_code)
strLine = Field2Str2(oRS!Lot_id) & vbTab & RTrim(strProj_Cont) & vbTab & RTrim(strProj_Code) & vbTab & RTrim(strProj_Desc) ' & " -- " & oRS!Desc
strLine = strLine & vbTab & RTrim(Field2Str(oRS!lot_no)) & vbTab & RTrim(strADDRESS) & vbTab & Field2Str2(oRS!proj_id)
lstContains.AddItem strLine
oRSP.Close
End If
End If
' strLINE = Field2Str2(oRS!lot_ID) & vbTab & RTrim(Field2Str(oRS!Proj_Cont)) & vbTab & RTrim(strProj_Desc) & vbTab & RTrim(strProj_Code) ' & " -- " & oRS!Desc
' strLINE = strLINE & vbTab & RTrim(Field2Str(oRS!Lot_NO)) & vbTab & RTrim(strADDRESS) & vbTab & Field2Str2(oRS!Proj_ID)
' lstContains.AddItem strLINE
' lstContains.ItemData(lstContains.NewIndex) = oRS("Proj_id")
oRS.MoveNext
' mboolSHOW = True
Loop
oRS.Close
If lstContains.ListCount = 0 Then
MsgBox "No Address Information Found"
Call cmdNewSearch_Click
Else
lstContains.ListIndex = 0
End If
' End If '1
End Sub
Private Sub CodeLoad()
Dim oRS As Recordset
Dim strSQL As String, strSELECT As String, strCode As String
mboolSHOW = False
lstProject.Visible = True
lstProject.Width = 4035
lstLots.Visible = False
lblProjCode.Visible = True
' lblDesc.Visible = True
strCode = Trim$(txtSCode.Text)
strSELECT = "proj_code LIKE '" & strCode & "*'" ' & """"
strSQL = "SELECT Proj_id, Proj_desc, proj_code FROM tblProject "
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
oRS.Filter = strSELECT
lstProject.Clear
Do Until oRS.EOF
lstProject.AddItem RTrim(oRS("Proj_desc")) ' & " -- " & oRS!Desc
lstProject.ItemData(lstProject.NewIndex) = oRS("Proj_id")
oRS.MoveNext
mboolSHOW = True
Loop
oRS.Close
If lstProject.ListCount = 0 Then
MsgBox "No Project/Subdivisions Found"
Call cmdNewSearch_Click
Else
lstProject.ListIndex = 0
End If
End Sub
Private Sub FindProject()
Dim strSQL As String, strSELECT As String, strCode As String
strSQL = "SELECT proj_code, proj_cont, jccode, proj_desc, bag100, pomax, inv_type, synthetic FROM tblProject WHERE proj_id = " & gintPROJID
' strSQL = "SELECT proj_code, proj_cont, jccode, desc FROM tblProject WHERE proj_id = " & lstProject.ItemData(lstProject.ListIndex)
Set moRSProj = New Recordset
moRSProj.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lblProjCode.Caption = moRSProj!proj_code & " -- " & moRSProj!proj_cont
' lblDesc = Field2Str(moRSProj!Desc)
If Len(lblDesc) > 0 Then
lblDesc.Visible = True
Else
lblDesc.Visible = False
End If
If moRSProj!bag100 Then
gboolBAG = True
cmdTakeR.Caption = "Takeoff PreMix"
mnuTakeR.Checked = False
mnuTake5.Checked = True
cmdOrderR.Caption = "Orders PreMix"
ElseIf moRSProj!SYNTHETIC Then
gboolSYN = True
cmdTakeR.Caption = "Takeoff Synthetic"
mnuTakeR.Checked = False
mnuTake5.Checked = True
cmdOrderR.Caption = "Orders Synthetic"
Else
gboolBAG = False
cmdTakeR.Caption = "Takeoff"
mnuTakeR.Checked = True
mnuTake5.Checked = False
cmdOrderR.Caption = "Orders"
End If
gbytINV_TYPE = Field2Str2(moRSProj!inv_type)
End Sub
Private Sub NameLoad()
Dim oRS As Recordset
Dim strSQL As String, strSELECT As String, strCode As String
mboolSHOW = False
lstProject.Visible = True
lstProject.Width = 4035
lstLots.Visible = False
lblProjCode.Visible = True
' lblDesc.Visible = True
strCode = Trim$(txtSName.Text)
strSELECT = "proj_desc LIKE '" & strCode & "*'" ' & """"
strSQL = "SELECT Proj_id, Proj_desc FROM tblProject "
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
oRS.Filter = strSELECT
lstProject.Clear
Do Until oRS.EOF
lstProject.AddItem RTrim(oRS("Proj_desc")) ' & " -- " & oRS!Desc
lstProject.ItemData(lstProject.NewIndex) = oRS("Proj_id")
oRS.MoveNext
mboolSHOW = True
Loop
oRS.Close
If lstProject.ListCount = 0 Then
MsgBox "No Project/Subdivisions Found"
Call cmdNewSearch_Click
Else
lstProject.ListIndex = 0
End If
End Sub
Private Sub mnuProject_Click()
frmProject.Show
End Sub
Private Sub mnuScaffold_Click()
frmScaffold.Show
End Sub
Private Sub mnuSupplier_Click()
frmSupplier.Show
End Sub
Private Sub mnuTake_Click()
' Call cmdTake_Click
End Sub
Private Sub mnuTexture_Click()
frmTexture.Show
End Sub
Private Sub mnuTOI_Click()
Dim strSQL As String, strSql2 As String, strSQL3 As String
Dim lngTOID As Long, lngOPTID As Long, lngProjID As Long
Dim strMOD_ELV As String, intCount As Integer, lngCOUNT As Long
Dim oRS As Recordset, oRSS As Recordset
On Error Resume Next
strSQL = "SELECT * FROM tblPOption"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
lngCOUNT = lngCOUNT + 1
strSql2 = "SELECT * FROM tblPlans WHERE est_id = " & Field2Long(oRS!est_id)
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
strMOD_ELV = Field2Str(oRSS!mod_elv)
lngProjID = Field2Long(oRSS!proj_id)
strSql2 = "SELECT * FROM tblTAKE WHERE proj_id = " & lngProjID & " AND pln_elv = '" & strMOD_ELV & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
intCount = oRSS.RecordCount
If intCount <> 0 Then
lngTOID = Field2Long(oRSS!toid)
strSql2 = "SELECT * FROM tblOption WHERE toid = " & lngTOID & " and desc = '" & Field2Str(oRS!Desc) & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
' If Not IsNull(oRSS!Create) Then
oRS!T_OptID = oRSS!OPTID
oRS.Update
' End If
End If
End If
oRS.MoveNext
Loop
MsgBox "Options Are Tied Together"
On Error GoTo 0
End Sub
Private Sub mnuTOI2_Click()
Dim strSQL As String
strSQL = "UPDATE tblTake SET mtmu = (mtmu/100) where mtmu > 0"
goConn.Execute strSQL
strSQL = "UPDATE tblTake SET mu = (mu/100) where mu > 0"
goConn.Execute strSQL
MsgBox "Transfer Flag Setup is Complete"
End Sub
Private Sub mnuUser_Click()
frmUser.Show
End Sub
Private Sub mnuYard1Date_Click()
crMain.ReportFileName = App.Path & "\YardOrder.rpt"
' crMain.SelectionFormula = strSQL
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub mnuYardRange_Click()
crMain.ReportFileName = App.Path & "\YardOrderRange.rpt"
' crMain.SelectionFormula = strSQL
' crMain.Destination = crptToWindow
crMain.Destination = crptToPrinter
crMain.WindowState = crptMaximized
crMain.Action = 1
End Sub
Private Sub txtSCode_Change()
cmdNewSearch.Enabled = True
End Sub
Private Sub txtSCode_LostFocus()
txtSCode.Text = UCase(txtSCode.Text)
If Len(txtSCode) > 0 Then
cmdFCode.Enabled = True
cmdFCode.SetFocus
End If
End Sub
Private Sub LotLoad()
Dim oRS As Recordset
Dim strSQL As String, strLine As String
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
strSQL = "SELECT lot_id, lot_no, address, model, owner from tbllotinfo WHERE Proj_ID = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstLots.Clear
Do Until oRS.EOF
With lstLots
strLine = oRS!lot_no & vbTab & oRS!model & vbTab & oRS!address & " --- " & oRS!Owner
.AddItem Field2Str(strLine)
.ItemData(.NewIndex) = oRS("lot_id")
End With
oRS.MoveNext
Loop
oRS.Close
If lstLots.ListCount Then
lstLots.ListIndex = 0
End If
End Sub
Private Sub txtSContain_GotFocus()
txtSContain.SelStart = 0
txtSContain.SelLength = 100
' If Len(txtSContain) > 0 Then
' txtSContain.SelText
' End If
End Sub
Private Sub txtSContain_LostFocus()
txtSContain.Text = UCase(txtSContain.Text)
If Len(txtSContain) > 0 Then
cmdFContain.Enabled = True
cmdFContain.SetFocus
End If
End Sub
Private Sub txtSName_Change()
cmdNewSearch.Enabled = True
End Sub
'Private Sub txtSName_Change()
' cmdNewSearch.Enabled = True
'End Sub
Private Sub txtSName_LostFocus()
txtSName.Text = UCase(txtSName.Text)
If Len(txtSName) > 0 Then
cmdFName.Enabled = True
cmdFName.SetFocus
End If
End Sub
Private Sub SetupTransfer()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARINVOICE WHERE ready"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblARTRANS"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblARTRANS"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
.AddNew
!invoice_no = oRS!invoice_no
!customer_no = oRS!customer_no
!invoice_date = oRS!invoice_date
!job_number = oRS!job_number
!inv_due_date = oRS!inv_due_date
!disc_due_date = oRS!disc_due_date
!non_tax_amt = oRS!non_tax_amt
!retention_amt = oRS!retention_amt
!sales_code = oRS!sales_code
!Description = Left$(Field2Str(oRS!Description), 30)
!price = oRS!price
!amount = oRS!amount
!ready = True
!shipping = Left$(Field2Str(oRS!project), 15)
!Comment = "Lot " & oRS!lot_no & "," & Left$(Field2Str(oRS!address), 20)
!taxcode = oRS!taxcode
.Update
oRS!ready = False
oRS!done = True
oRS.Update
oRS.MoveNext
End With
Loop
'''' Call mnuAREdit_Click
'' crMain.Reset
'' crMain.ReportFileName = App.Path & "\AREdit.rpt"
' crMain.Formulas(1) = "Sand = " & intORDER
' crMain.ReplaceSelectionFormula (strSQL)
'' crMain.CopiesToPrinter = 1
'' crMain.Destination = crptToWindow
' crMain.Destination = crptToPrinter
'' crMain.Action = 1
'''' Call FixBilling
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SetupMARTransfer()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARINVOICEM WHERE ready"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblARTRANSM"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblARTRANSM"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
.AddNew
!invoice_no = oRS!invoice_no
!customer_no = oRS!customer_no
!invoice_date = oRS!invoice_date
!job_number = oRS!job_number
!inv_due_date = oRS!inv_due_date
!disc_due_date = oRS!disc_due_date
!non_tax_amt = oRS!non_tax_amt
!retention_amt = oRS!retention_amt
!sales_code = oRS!sales_code
!Description = Left$(Field2Str(oRS!Description), 30)
!price = oRS!price
!amount = oRS!amount
!ready = True
!shipping = Left$(Field2Str(oRS!project), 15)
!Comment = "Lot " & oRS!lot_no & "," & Left$(Field2Str(oRS!address), 20)
!taxcode = oRS!taxcode
.Update
oRS!ready = False
oRS!done = True
oRS.Update
oRS.MoveNext
End With
Loop
crMain.Reset
crMain.ReportFileName = App.Path & "\ARTransM.rpt"
' crMain.Formulas(1) = "Sand = " & intORDER
' crMain.ReplaceSelectionFormula (strSQL)
crMain.CopiesToPrinter = 1
crMain.Destination = crptToWindow
' crMain.Destination = crptToPrinter
crMain.Action = 1
Call FixBillingM
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupMARTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SetupARTransfer()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
Dim oRL As Recordset, oRP As Recordset
Dim strSQL3 As String, strSQL4 As String
Dim strDUEDATE As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblOrders WHERE AR and CoCode = 0"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblSWARTRANS"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblSWARTRANS"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
strSQL3 = "SELECT lot_id, proj_id, jobcost, lot_no, address FROM tblLotInfo WHERE lot_id = " & Field2Long(oRS!Lot_id)
Set oRL = New Recordset
oRL.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
strSQL4 = "SELECT proj_id, proj_desc FROM tblProject WHERE proj_id = " & oRL!proj_id
Set oRP = New Recordset
oRP.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
Else
MsgBox "No Lot Found", vbOKOnly, "No Lot"
Exit Sub
End If
.AddNew
!invoice_no = oRS!sup_inv
' !customer_no = oRS!customer_no
!invoice_date = oRS!inv_date
!job_number = oRS!po_num
If Not IsDate(oRS!inv_date) Then
MsgBox "An Invalid Date Was Encountered - Fix & ReTransfer", vbOKOnly, "Invalid Date"
Exit Sub
End If
!inv_due_date = DateAdd("d", 30, oRS!inv_date)
!disc_due_date = DateAdd("d", 30, oRS!inv_date)
!non_tax_amt = oRS!orderamt
!retention_amt = 0
If Field2Str(oRS!m_type) = "L" Then
!sales_code = "LATH"
!Description = "LATH MATERIALS"
ElseIf Field2Str(oRS!m_type) = "R" Then
!sales_code = "SPO"
!Description = "SPECIAL PURCHASE ORDER"
ElseIf Field2Str(oRS!m_type) = "S" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
ElseIf Field2Str(oRS!m_type) = "B" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
ElseIf Field2Str(oRS!m_type) = "T" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
End If
!price = oRS!orderamt
!amount = oRS!orderamt
!ready = True
!shipping = Left$(Field2Str(oRP!proj_desc), 15)
!Comment = "Lot " & oRL!lot_no & "," & Left$(Field2Str(oRL!address), 20)
.Update
oRS!ar = False
oRS!ar_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupARTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SetupARMTransfer()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
Dim oRL As Recordset, oRP As Recordset
Dim strSQL3 As String, strSQL4 As String
Dim strDUEDATE As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblOrders WHERE AR and CoCode = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblSWARTRANSM"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblSWARTRANSM"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
strSQL3 = "SELECT lot_id, proj_id, jobcost, lot_no, address FROM tblLotInfo WHERE lot_id = " & Field2Long(oRS!Lot_id)
Set oRL = New Recordset
oRL.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
strSQL4 = "SELECT proj_id, proj_desc FROM tblProject WHERE proj_id = " & oRL!proj_id
Set oRP = New Recordset
oRP.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
Else
MsgBox "No Lot Found", vbOKOnly, "No Lot"
Exit Sub
End If
.AddNew
!invoice_no = oRS!sup_inv
' !customer_no = oRS!customer_no
!invoice_date = oRS!inv_date
!job_number = oRS!po_num
If Not IsDate(oRS!inv_date) Then
MsgBox "An Invalid Date Was Encountered - Fix & ReTransfer", vbOKOnly, "Invalid Date"
Exit Sub
End If
!inv_due_date = DateAdd("d", 30, oRS!inv_date)
!disc_due_date = DateAdd("d", 30, oRS!inv_date)
!non_tax_amt = oRS!orderamt
!retention_amt = 0
If Field2Str(oRS!m_type) = "L" Then
!sales_code = "LATH"
!Description = "LATH MATERIALS"
ElseIf Field2Str(oRS!m_type) = "R" Then
!sales_code = "SPO"
!Description = "SPECIAL PURCHASE ORDER"
ElseIf Field2Str(oRS!m_type) = "S" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
ElseIf Field2Str(oRS!m_type) = "B" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
ElseIf Field2Str(oRS!m_type) = "T" Then
!sales_code = "STUC"
!Description = "STUCCO MATERIAL"
End If
!price = oRS!orderamt
!amount = oRS!orderamt
!ready = True
!shipping = Left$(Field2Str(oRP!proj_desc), 15)
!Comment = "Lot " & oRL!lot_no & "," & Left$(Field2Str(oRL!address), 20)
.Update
oRS!ar = False
oRS!ar_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupARMTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SetupAPTransfer()
Dim strSQL As String, strSql2 As String, strSQL3 As String
Dim oRS As Recordset, oRSS As Recordset, oRSP As Recordset
Dim intDay As Integer, intMonth As Integer, intYear As Integer
Dim strDUE As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblOrders WHERE AP and CoCode = 0"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblAPTRANS"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblAPTRANS"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
strSQL3 = "SELECT * FROM tblSupplier WHERE supplier = '" & Field2Str(oRS!supplier) & "'"
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If oRSP.EOF Then
MsgBox "No Supplier Information Was Found - Correct and ReTransfer", vbOKOnly, "Invalid Supplier"
Exit Sub
End If
If Not IsDate(oRS!inv_date) Then
MsgBox "An Invalid Date Was Encountered - Fix & ReTransfer", vbOKOnly, "Invalid Date"
Exit Sub
End If
intDay = Day(oRS!inv_date)
intMonth = Month(oRS!inv_date)
intYear = Format(Year(oRS!inv_date), "0000")
Select Case intDay
Case 1 To 25
If intMonth > 11 Then
intMonth = 1
intYear = intYear + 1
Else
intMonth = intMonth + 1
End If
strDUE = CStr(intMonth) & "/15/" & CStr(intYear)
Case 26 To 31
If intMonth > 10 Then
intMonth = (intMonth + 2) - 12
intYear = intYear + 1
Else
intMonth = intMonth + 2
End If
strDUE = CStr(intMonth) & "/15/" & CStr(intYear)
End Select
.AddNew
!invoice_no = Field2Str2(oRS!sup_inv)
!vendor_no = Field2Str(oRSP!vendor_no)
!invoice_date = Field2Str(oRS!inv_date)
!job_number = Field2Str(oRS!jobcost)
!inv_due_date = Field2Str2(strDUE)
!disc_due_date = DateAdd("d", 30, strDUE)
!non_tax_amt = Field2Str2(oRS!orderamt)
!net_invc_amt = Field2Str2(oRS!orderamt)
!invoice_amt = Field2Str2(oRS!orderamt)
!discount_amt = Format(Field2Str2((oRS!orderamt * (oRSP!disc / 100))), "#,#.00")
!terms_code = Field2Str(oRSP!terms)
!ready = True
.Update
oRS!ap = False
oRS!ap_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
MsgBox "VWP Accounts Payable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupAPTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SetupMAPTransfer()
Dim strSQL As String, strSql2 As String, strSQL3 As String
Dim oRS As Recordset, oRSS As Recordset, oRSP As Recordset
Dim intDay As Integer, intMonth As Integer, intYear As Integer
Dim strDUE As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblOrders WHERE AP and CoCode = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
strSql2 = "DELETE * FROM tblAPTRANSM"
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblAPTRANSM"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
With oRSS
strSQL3 = "SELECT * FROM tblSupplier WHERE supplier = '" & Field2Str(oRS!supplier) & "'"
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If oRSP.EOF Then
MsgBox "No Supplier Information Was Found - Correct and ReTransfer", vbOKOnly, "Invalid Supplier"
Exit Sub
End If
If Not IsDate(oRS!inv_date) Then
MsgBox "An Invalid Date Was Encountered - Fix & ReTransfer", vbOKOnly, "Invalid Date"
Exit Sub
End If
intDay = Day(oRS!inv_date)
intMonth = Month(oRS!inv_date)
intYear = Format(Year(oRS!inv_date), "0000")
Select Case intDay
Case 1 To 25
If intMonth > 11 Then
intMonth = 1
intYear = intYear + 1
Else
intMonth = intMonth + 1
End If
strDUE = CStr(intMonth) & "/15/" & CStr(intYear)
Case 26 To 31
If intMonth > 10 Then
intMonth = (intMonth + 2) - 12
intYear = intYear + 1
Else
intMonth = intMonth + 2
End If
strDUE = CStr(intMonth) & "/15/" & CStr(intYear)
End Select
.AddNew
!invoice_no = Field2Str2(oRS!sup_inv)
!vendor_no = Field2Str(oRSP!vendor_no)
!invoice_date = Field2Str(oRS!inv_date)
!job_number = Field2Str(oRS!jobcost)
!inv_due_date = Field2Str2(strDUE)
!disc_due_date = DateAdd("d", 30, strDUE)
!non_tax_amt = Field2Str2(oRS!orderamt)
!net_invc_amt = Field2Str2(oRS!orderamt)
!invoice_amt = Field2Str2(oRS!orderamt)
!discount_amt = Format(Field2Str2((oRS!orderamt * (oRSP!disc / 100))), "#,#.00")
!terms_code = Field2Str(oRSP!terms)
!ready = True
.Update
oRS!ap = False
oRS!ap_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
MsgBox "Metro Accounts Payable is now ready for Transfer - Go to MAS90 to Import", vbOKOnly, "Goto MAS90"
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupMAPTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Reference in New Issue View Git Blame Copy Permalink