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

7287 lines
240 KiB
Plaintext
Raw Permalink 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 = "Microsoft 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
Begin VB.CommandButton cmdPOBill
Caption = "Process WO && PO Bills"
Height = 495
Left = 8220
TabIndex = 49
Top = 2700
Width = 1515
End
Begin VB.CommandButton cmdFJCCode
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 = 135
Picture = "frmMain.frx":068A
Style = 1 'Graphical
TabIndex = 47
Top = 2835
Width = 555
End
Begin VB.TextBox txtSJCCode
Height = 375
Left = 780
TabIndex = 46
Top = 2880
Width = 2475
End
Begin LpLib.fpList lstContains
Height = 2835
Left = 105
TabIndex = 44
Top = 4230
Visible = 0 'False
Width = 11625
_Version = 196608
_ExtentX = 20505
_ExtentY = 5001
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 = 8
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":0ACC
End
Begin VB.TextBox txtSContain
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 780
TabIndex = 5
Top = 2190
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 = 135
Picture = "frmMain.frx":102F
Style = 1 'Graphical
TabIndex = 6
Top = 2160
Width = 555
End
Begin VB.CommandButton cmdUpRGard
Caption = "Update OptNum"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5640
TabIndex = 42
Top = 8025
Visible = 0 'False
Width = 960
End
Begin VB.CommandButton cmdReNum
Caption = "ReNumber"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 3975
TabIndex = 41
Top = 8025
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdFixBill
Caption = "Setup Billing"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 1980
TabIndex = 40
Top = 8025
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton cmdHourly
Caption = "Hourly Payroll"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9840
TabIndex = 39
Top = 2700
Width = 1515
End
Begin VB.CommandButton cmdJCList
Caption = "Select JC List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3360
TabIndex = 37
Top = 2175
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdFindSPO
Caption = "Find Special PO Info."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9840
TabIndex = 36
Top = 2175
Width = 1515
End
Begin VB.CommandButton cmdFindOrder
Caption = "Find Purchase Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4965
TabIndex = 35
Top = 2175
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"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 8220
TabIndex = 34
TabStop = 0 'False
Top = 2175
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdProjNotes
Caption = "Pro&Ject Notes"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6555
TabIndex = 33
TabStop = 0 'False
Top = 2175
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdInvoice
Caption = "Builder Invoice List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9840
TabIndex = 32
TabStop = 0 'False
Top = 80
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdShip
Caption = "Lot Invoice && Shipping"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9840
TabIndex = 31
TabStop = 0 'False
Top = 600
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdBilling
Caption = "Billing &Grid"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9825
TabIndex = 30
TabStop = 0 'False
Top = 1110
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdScafList
Caption = "Scaffold List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9840
TabIndex = 29
TabStop = 0 'False
Top = 1650
Width = 1515
End
Begin VB.CommandButton cmdPrintJCRpt
Caption = "Print Only - Job Cost Reports"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 8220
TabIndex = 28
TabStop = 0 'False
Top = 1650
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdJCRpt
Caption = "Calculate && Print Job Cost"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6555
TabIndex = 27
TabStop = 0 'False
Top = 1650
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdJCUpdate
Caption = "&Update Lot Job Code Info"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4965
TabIndex = 26
TabStop = 0 'False
Top = 1650
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdScaffold
Caption = "Scaffold Information"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3345
TabIndex = 25
TabStop = 0 'False
Top = 1650
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdPOInfo
Caption = "PO Information"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3360
TabIndex = 23
TabStop = 0 'False
Top = 600
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdLotInfo
Caption = "Lot &Information"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 8220
TabIndex = 22
TabStop = 0 'False
Top = 1125
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdSchedule
Caption = "&Schedule Repair"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6585
TabIndex = 21
TabStop = 0 'False
Top = 1125
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdRepairList
Caption = "Repair List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4980
TabIndex = 20
TabStop = 0 'False
Top = 1125
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"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 8220
TabIndex = 19
TabStop = 0 'False
Top = 600
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdPOList
Caption = "Process Payroll"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3360
TabIndex = 18
TabStop = 0 'False
Top = 1125
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 = 600
Visible = 0 'False
Width = 1515
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4980
TabIndex = 16
TabStop = 0 'False
Top = 600
Width = 1515
End
Begin VB.CommandButton cmdPayroll
Caption = "&Payroll Information"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6600
TabIndex = 15
TabStop = 0 'False
Top = 80
Width = 1515
End
Begin VB.CommandButton cmdNewSearch
Caption = "&New Search"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 8220
TabIndex = 14
TabStop = 0 'False
Top = 80
Width = 1515
End
Begin VB.CommandButton cmdPlans
Caption = "&Plans"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1740
TabIndex = 13
TabStop = 0 'False
Top = 80
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 = 840
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 = 795
TabIndex = 2
Top = 1485
Width = 2475
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":1471
Style = 1 'Graphical
TabIndex = 1
Top = 780
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 = 135
Picture = "frmMain.frx":18B3
Style = 1 'Graphical
TabIndex = 3
Top = 1470
Width = 555
End
Begin VB.CommandButton cmdTakeR
Caption = "&Takeoff"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3375
TabIndex = 7
TabStop = 0 'False
Top = 80
Width = 1515
End
Begin VB.CommandButton cmdOrderR
Caption = "&Orders"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4980
TabIndex = 10
Top = 80
Width = 1515
End
Begin VB.CommandButton cmdLotSearch
Caption = "&Lot Search"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 105
TabIndex = 4
TabStop = 0 'False
Top = 80
Width = 1515
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.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.Label lblJCCode
AutoSize = -1 'True
Caption = "Search JC Code"
BeginProperty Font
Name = "Microsoft Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 48
Top = 2580
Width = 1680
End
Begin VB.Label lblCALC
Alignment = 2 'Center
BackColor = &H0080FFFF&
Caption = "Calculating - Be Patient"
BeginProperty Font
Name = "Arial Black"
Size = 24
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 630
Left = 1140
TabIndex = 45
Top = 7185
Visible = 0 'False
Width = 6885
End
Begin VB.Label lblContain
AutoSize = -1 'True
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 = 1905
Width = 2115
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 = 9030
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 = 3315
Visible = 0 'False
Width = 9030
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 = 105
TabIndex = 12
Top = 555
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 = 105
TabIndex = 11
Top = 1245
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
Visible = 0 'False
End
Begin VB.Menu mnuJCTrans
Caption = "&JC Transfer Complete"
Enabled = 0 'False
Visible = 0 'False
End
Begin VB.Menu mnuCMSAP
Caption = "Import CMS AP Info"
Enabled = 0 'False
End
Begin VB.Menu mnuCMSAR
Caption = "Import CMS AR Info"
Enabled = 0 'False
End
Begin VB.Menu mnuCMSPP
Caption = "Import CMS PosPay Info VWP"
Enabled = 0 'False
Begin VB.Menu mnuCMSPPVW
Caption = "Valley Wide"
End
Begin VB.Menu mnuCMSPPSW
Caption = "SuperWall"
End
End
Begin VB.Menu mnuAddPPay
Caption = "Enter PosPay Checks For Upload To Bank"
Enabled = 0 'False
Begin VB.Menu mnuAddPPayV
Caption = "Valley Wide"
End
Begin VB.Menu mnuAddPPayS
Caption = "SuperWall"
End
Begin VB.Menu mnuAddPPayC
Caption = "Casa Rica"
End
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"
Enabled = 0 'False
Begin VB.Menu mnuABTPosPayV
Caption = "AZ Bank and Trust - VWP"
End
Begin VB.Menu mnuABTPosPayS
Caption = "AZ Bank and Trust - SWI"
End
Begin VB.Menu mnuABTPosPayC
Caption = "AZ Bank and Trust - CRD"
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 mnuAREditMenu
Caption = "AR Edit List"
Begin VB.Menu mnuAREdit
Caption = "AR Edit for SW"
End
Begin VB.Menu mnuAREdit2
Caption = "AR Edit List For Lots"
End
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, moRSPPay As Recordset, moRSAPHist As Recordset
Dim mstrBegDate As String, mstrEndDate As String, moRSARHist As Recordset
Dim mboolSHOW As Boolean, mboolMARK As Boolean
Dim mboolPRINT As Boolean, mboolREPORT As Boolean, mboolWINDOW As Boolean
Private Sub cmdBilling_Click()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
frmBilling.Show 1
End Sub
Private Sub UpTOMatrl()
Dim strSQL As String, oRS As Recordset, strSQLL As String, oRSS As Recordset
lblCALC.Caption = "Updating tblTOMatrl"
lblCALC.Visible = True
DoEvents
strSQL = "SELECT * FROM tblTOMAT"
' strSQL = "SELECT * FROM tblTOMATRLxx WHERE TOID < 2000"
Set oRS = New Recordset
oRS.Open strSQL, goConn ', adOpenDynamic, adLockOptimistic
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "tblTOMat Not Open - EXITING", vbOKOnly
lblCALC.Visible = False
Exit Sub
End If
strSQLL = "SELECT * FROM tblTOMatrl"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic
If oRSS.EOF Then
MsgBox "tblTOMatrl Not Open - EXITING", vbOKOnly
lblCALC.Visible = False
Exit Sub
End If
oRS.MoveFirst
Do Until oRS.EOF
oRSS.AddNew
oRSS!toid = oRS!toid
oRSS!inv_no = oRS!inv_no
oRSS!Desc = oRS!Desc
oRSS!qty = oRS!qty
oRSS!price = oRS!price
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!calc_flag = oRS!calc_flag
oRSS!calc_amt = oRS!calc_amt
oRSS!trnsflag = oRS!trnsflag
oRSS!cflag = oRS!cflag
oRSS.Update
oRS.MoveNext
Loop
oRS.Close
oRSS.Close
MsgBox ("TakeOff MATERIAL Inventory Number is UpDated")
lblCALC.Visible = False
End Sub
Private Sub UpLOTMatrl()
Dim strSQL As String, oRS As Recordset, strSQLL As String, oRSS As Recordset
lblCALC.Caption = "Updating tblLOTMatrl"
lblCALC.Visible = True
DoEvents
strSQL = "SELECT * FROM tblLOTMAT"
' strSQL = "SELECT * FROM tblTOMATRLxx WHERE TOID < 2000"
Set oRS = New Recordset
oRS.Open strSQL, goConn4 ', adOpenDynamic, adLockOptimistic
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "tblLOTMAT Not Open - EXITING", vbOKOnly
lblCALC.Visible = False
Exit Sub
End If
strSQLL = "SELECT * FROM tblLOTMatrl"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn4, adOpenKeyset, adLockOptimistic
If oRSS.EOF Then
MsgBox "tblLOTMatrl Not Open - EXITING", vbOKOnly
lblCALC.Visible = False
Exit Sub
End If
oRS.MoveFirst
Do Until oRS.EOF
oRSS.AddNew
oRSS!Lot_ID = oRS!Lot_ID
oRSS!inv_no = oRS!inv_no
oRSS!Desc = oRS!Desc
oRSS!qty = oRS!qty
oRSS!price = oRS!price
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!calc_flag = oRS!calc_flag
oRSS!calc_amt = oRS!calc_amt
oRSS!ch_flag = oRS!ch_flag
oRSS!rc_flag = oRS!rc_flag
oRSS!o_qty = oRS!o_qty
oRSS!Prnt_Flag = oRS!Prnt_Flag
oRSS.Update
oRS.MoveNext
Loop
oRS.Close
oRSS.Close
MsgBox ("LOT MATERIAL Inventory Number is UpDated")
lblCALC.Visible = False
End Sub
Private Sub ImportCMSPPVW()
Dim intYN As Integer, strSQL As String, strFile As String, oRS As Recordset, strLine As String
Dim oRSS As Recordset, strSQLL As String, boolNEW As Boolean
Dim strF() As String, strOLD As String, strNEW As String, strJOBNUM As String, intCOUNT As Integer
Dim strVend As String, strINVOICE As String, strTYPE As String, strINVDATE As String, strJCCODE As String, dblAmt As String
Dim strVNAME As String, strSQLV As String, oRSAPV As Recordset
Dim strName As String
On Error GoTo Error_EH
boolNEW = False
' cdMain.InitDir = "G:\Access\PosPay\"
cdMain.InitDir = "G:\A_PosPay\PosPayVW\"
cdMain.Action = 1
strFile = cdMain.FileName
intCOUNT = 0
strSQL = "Select * FROM tblPosPayVWP"
Set moRSPPay = New Recordset
moRSPPay.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
Open strFile For Input As #1
Do Until EOF(1)
Line Input #1, strLine
strF = Split(strLine, vbTab)
If intCOUNT = 0 Then
strVend = Mid(Field2Str(strF(0)), 4, 15)
intCOUNT = 99
Else
strVend = Field2Str(strF(0))
End If
strINVOICE = Field2Str(strF(2))
strTYPE = Format(Field2Str(strF(4)), "0000000.00")
strJCCODE = Field2Str(strF(5))
strJOBNUM = Left(strJCCODE, 10)
strName = Field2Str(strF(7))
strSQLV = "SELECT * FROM tblPosPayVWP WHERE CKNumber = '" & strINVOICE & "'"
Set oRSS = New Recordset
oRSS.Open strSQLV, goConn, adOpenDynamic, adLockPessimistic
If oRSS.EOF Then
With oRSS
boolNEW = True
.AddNew
!CKNumber = strINVOICE
!CKAmt = Field2Str2(strTYPE)
!CKDate = strJOBNUM
!Name = Left(strName, 30)
.Update
End With
' End If
End If
' moRSAPHist.MoveNext
Loop
moRSPPay.Close
Close #1
If boolNEW Then
MsgBox ("Import of VWP CMS AP Data is Complete"), vbInformation + vbOKOnly, "Import Complete"
Else
MsgBox ("No New Items Were Added"), vbOKOnly, "No PosPay"
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module ImportCMSPPVW " & gstrMODULE
Call ErrorHandler2
gstrMODULE = ""
Close #1
Exit Sub
End Sub
Private Sub ImportCMSPPSW()
Dim intYN As Integer, strSQL As String, strFile As String, oRS As Recordset, strLine As String
Dim oRSS As Recordset, strSQLL As String, boolNEW As Boolean
Dim strF() As String, strOLD As String, strNEW As String, strJOBNUM As String, intCOUNT As Integer
Dim strVend As String, strINVOICE As String, strTYPE As String, strINVDATE As String, strJCCODE As String, dblAmt As String
Dim strVNAME As String, strSQLV As String, oRSAPV As Recordset
Dim strName As String
On Error GoTo Error_EH
boolNEW = False
cdMain.InitDir = "G:\A_PosPay\PosPaySW\"
cdMain.Action = 1
strFile = cdMain.FileName
intCOUNT = 0
strSQL = "Select * FROM tblPosPaySWI"
Set moRSPPay = New Recordset
moRSPPay.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
Open strFile For Input As #1
Do Until EOF(1)
Line Input #1, strLine
strF = Split(strLine, vbTab)
If intCOUNT = 0 Then
strVend = Mid(Field2Str(strF(0)), 4, 15)
intCOUNT = 99
Else
strVend = Field2Str(strF(0))
End If
strINVOICE = Field2Str(strF(2))
strTYPE = Format(Field2Str(strF(4)), "0000000.00")
strJCCODE = Field2Str(strF(5))
strName = Field2Str(strF(7))
strJOBNUM = Left(strJCCODE, 10)
strSQLV = "SELECT * FROM tblPosPaySWI WHERE CKNumber = '" & strINVOICE & "'"
Set oRSS = New Recordset
oRSS.Open strSQLV, goConn, adOpenDynamic, adLockPessimistic
If oRSS.EOF Then
With oRSS
boolNEW = True
.AddNew
!CKNumber = strINVOICE
!CKAmt = Field2Str2(strTYPE)
!CKDate = strJOBNUM
!Name = Left(strName, 30)
.Update
End With
' End If
End If
' moRSAPHist.MoveNext
Loop
moRSPPay.Close
Close #1
If boolNEW Then
MsgBox ("Import of SWI CMS AP Data is Complete"), vbInformation + vbOKOnly, "Import Complete"
Else
MsgBox ("No New Items Were Added"), vbOKOnly, "No PosPay"
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module ImportCMSPPSW " & gstrMODULE
Call ErrorHandler2
gstrMODULE = ""
Close #1
Exit Sub
End Sub
Private Sub ImportCMSAP()
Dim intYN As Integer, strSQL As String, strFile As String, oRS As Recordset, strLine As String
Dim strF() As String, strOLD As String, strNEW As String, strJOBNUM As String, intCOUNT As Integer
Dim strVend As String, strINVOICE As String, strTYPE As String, strINVDATE As String, strJCCODE As String, dblAmt As String
Dim strVNAME As String, strSQLV As String, oRSAPV As Recordset, strFILEX As String, strLineX As String
Dim strSQLLL As String, oRSI As Recordset, boolJCGood As Boolean
On Error GoTo Error_EH
boolJCGood = False
cdMain.InitDir = "G:\Access\Export\"
cdMain.Action = 1
strFile = cdMain.FileName
strFILEX = "G:\Access\EXPORT\"
strFILEX = strFILEX & Format(Date, "YYYYMMDD_APError.txt")
intCOUNT = 0
strSQLV = "SELECT * FROM tblJCVENDOR"
Set oRSAPV = New Recordset
oRSAPV.Open strSQLV, goConn, adOpenDynamic, adLockPessimistic
' mstrDEVICE = InputBox("Enter The Device Number (SYM#) To Import", "Import Prompts")
' mstrDEVICE = UCase(mstrDEVICE)
strSQL = "Select * FROM APH_JobDistDetail"
Set moRSAPHist = New Recordset
moRSAPHist.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
Open strFile For Input As #1
Open strFILEX For Output As #2
Do Until EOF(1)
Line Input #1, strLine
strLineX = strLine
strF = Split(strLine, vbTab)
If intCOUNT = 0 Then
strVend = Mid(Field2Str(strF(0)), 4, 15)
' strVend = Mid(Field2Str(strF(0)), 4, 15)
intCOUNT = 99
Else
strVend = Field2Str(strF(0))
End If
strINVOICE = Field2Str(strF(1))
strTYPE = Field2Str(strF(2))
strINVDATE = Field2Str(strF(3))
strJCCODE = Field2Str(strF(4))
strJOBNUM = Left(strJCCODE, 7)
dblAmt = Field2Str2(strF(5))
strSQLV = "SELECT * FROM tblJCVENDOR WHERE ARCode = '" & strVend & "'"
Set oRSAPV = New Recordset
oRSAPV.Open strSQLV, goConn, adOpenDynamic, adLockPessimistic
If Not oRSAPV.EOF Then
strSQL = "SELECT * FROM APH_JobDistDetail WHERE InvoiceNumber = '" & strINVOICE & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
'*Need to get a list of vendors that are JC Vendors to compare against this file
' If Left(strJOBNUM, 2) = "A0" Or Left(strJOBNUM, 2) = "B0" Then
If oRS.EOF Then
With moRSAPHist
.AddNew
!Division = "00"
!VendorNumber = Left(Field2Str(strVend), 30)
!InvoiceNumber = Field2Str2(strINVOICE)
gstrMODULE = strJOBNUM & " Inv# " & strINVOICE
!JobNumber = Field2Str(strJOBNUM)
!CostCode = "201200000"
!CostType = "0"
!distributionamount = dblAmt
!RetentionAmount = 0
!Balance = 0
!AmountAppliedToday = 0
!InvoiceDate = strINVDATE
!InvType = Field2Str(strTYPE)
strSQLLL = "SELECT PROJ_ID, LOT_ID FROM tblLOTINFO WHERE JobCost = '" & Field2Str(strJOBNUM) & "'"
Set oRSI = New Recordset
oRSI.Open strSQLLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSI.EOF Then
!PROJ_ID = Field2Str2(oRSI!PROJ_ID)
!Lot_ID = Field2Str2(oRSI!Lot_ID)
End If
.Update
End With
Else
Print #2, strLineX
' Write #2, strLineX
End If
End If
' moRSAPHist.MoveNext
Loop
moRSAPHist.Close
oRSI.Close
Close #1
Close #2
MsgBox ("Import of CMS AP Data is Complete"), vbInformation + vbOKOnly, "Import Complete"
' intYN = MsgBox("Do You Want To Rename The Import File?", vbYesNo, "Rename File")
' If intYN = vbYes Then
' strOLD = "PPCINV.TXT"
' lngLOC = InStr(1, strFILE, ".", 1)
' strHOLD = Mid(strFILE, lngLOC - 8, lngLOC - 1)
' strOLD = strHOLD
' lngLOC = InStr(1, strFILE, ".", 1)
' strHOLD = Mid(strFILE, 1, lngLOC - 1)
' strOLD = strHOLD
' strOLD = strFILE
' strNEW = "PPCINV" & Trim$(strMIN) & Trim$(strSEC) & ".TXT"
' strNEW = Trim$(strMONTH) & Trim$(strDAY) & Trim$(strSEC) & Trim$(strHOLD) & ".TXT"
' strNEW = Trim$(strMIN) & Trim$(strSEC) & Trim$(strMONTH) & Trim$(strDAY) & Trim$(strHOLD) ' & ".TXT"
' Name strFILE As strNEW
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module ImportCMSAP " & gstrMODULE
Call ErrorHandler2
gstrMODULE = ""
Close #1
Exit Sub
End Sub
Private Sub ImportCMSAR()
Dim intYN As Integer, strSQL As String, strFile As String, oRS As Recordset, strLine As String
Dim strF() As String, strOLD As String, strNEW As String, strJOBNUM As String, intCOUNT As Integer
Dim strINVOICE As String, strINVDATE As String, strCustomer As String, strJCCODE As String
Dim strTAXSALESAMT As String, strNONTAXSALESAMT As String, strSALESTAXAMT As String
Dim bytINVTYPE As Byte, strSEQUENCENum As String, strCUSTNAME As String, lngUNIQUEID As Long
Dim strFILEX As String, strLineX As String, boolJCGood As Boolean, lngCNT As Long
Dim strSQLLL As String, oRSI As Recordset, strFILEXX As String, strLineXX As String
'Dim sglNum2 As Single, lngNum3 As Long
'Dim lngLOC As Long, strHOLD As String
'Dim strSEC As String, strMIN As String, strDAY As String, strMONTH As String
On Error GoTo Error_EH
boolJCGood = False
' mstrDEVICE = ""
' strSEC = Second(Time)
' strMIN = Minute(Time)
' strDAY = Format(Day(Date), "00")
' strMONTH = Format(Month(Date), "00")
cdMain.InitDir = "G:\Access\Export\"
cdMain.Action = 1
strFile = cdMain.FileName
strFILEX = "G:\Access\EXPORT\"
strFILEX = strFILEX & Format(Date, "YYYYNNDD_ARError.txt")
strFILEXX = "G:\Access\EXPORT\"
strFILEXX = strFILEXX & Format(Date, "YYYYNNDD_ARError2.txt")
intCOUNT = 0
lngCNT = 1
' mstrDEVICE = InputBox("Enter The Device Number (SYM#) To Import", "Import Prompts")
' mstrDEVICE = UCase(mstrDEVICE)
strSQL = "Select * FROM ARN_InvHistoryHeader"
Set moRSARHist = New Recordset
moRSARHist.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
Open strFile For Input As #1
Open strFILEX For Output As #2
Open strFILEXX For Output As #3
Do Until EOF(1)
Line Input #1, strLine
strLineX = strLine
strLineXX = lngCNT & " " & strLine
lngCNT = lngCNT + 1
strF = Split(strLine, vbTab)
If intCOUNT = 0 Then
lngUNIQUEID = Mid(Field2Str(strF(0)), 4, 1)
intCOUNT = 99
Else
lngUNIQUEID = Field2Str2(strF(0))
End If
' lngUNIQUEID = Field2Str2(strF(0))
bytINVTYPE = Field2Str2(strF(1))
strCustomer = Field2Str(strF(2))
strCUSTNAME = Field2Str(strF(3))
strINVOICE = Field2Str(strF(4))
strINVDATE = Left(Field2Str(strF(5)), 10)
strJCCODE = Field2Str(strF(6))
If Len(strJCCODE) = 7 Then
boolJCGood = True
Else
boolJCGood = False
End If
strNONTAXSALESAMT = Field2Str2(strF(7))
strTAXSALESAMT = 0
' strTAXSALESAMT = Field2Str2(strF(7))
strSQL = "SELECT * FROM ARN_InvHistoryHeader WHERE InvoiceNumber = '" & strINVOICE & "' AND JOBNUMBER = '" & strJCCODE & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
' If Left(strJOBNUM, 2) = "A0" Or Left(strJOBNUM, 2) = "B0" Then
If oRS.EOF Then
If boolJCGood Then
With moRSARHist
.AddNew
' !I = "00"
!InvoiceNumber = Left(Field2Str2(strINVOICE), 20)
!InvoiceDate = strINVDATE
!CustomerNumber = Left(Field2Str(strCustomer), 20)
gstrMODULE = "Job " & strJCCODE & " Inv# " & strINVOICE
!JobNumber = Field2Str(strJCCODE)
!TaxableSalesAmount = Field2Str2(strTAXSALESAMT)
!NonTaxableSalesAmount = Field2Str2(strNONTAXSALESAMT)
!InvoiceType = bytINVTYPE
!CustName = Field2Str(strCUSTNAME)
!intunique = lngUNIQUEID
!SalesTaxAmount = 0
' !AmountAppliedToday = 0
' !InvType = Field2Str(strTYPE)
strSQLLL = "SELECT PROJ_ID, LOT_ID FROM tblLOTINFO WHERE JobCost = '" & Field2Str(strJCCODE) & "'"
Set oRSI = New Recordset
oRSI.Open strSQLLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSI.EOF Then
!PROJ_ID = Field2Str2(oRSI!PROJ_ID)
!Lot_ID = Field2Str2(oRSI!Lot_ID)
'!
End If
.Update
End With
Else
' oRS!JobNumber = Field2Str(strJCCODE)
' ors!InvoiceDate
' oRS.Update
Print #2, strLineX
End If
Else
' oRS!JobNumber = Field2Str(strJCCODE)
' oRS.Update
Print #3, strLineXX 'Items not in ARN_InvHistoryHeader
End If
' moRSAPHist.MoveNext
Loop
moRSARHist.Close
Close #1
Close #2
Close #3
' Call cmdNewSearch_Click
' lblCALC.Visible = True
' DoEvents
' Call cmdFixBill_Click
' lblCALC.Visible = False
' DoEvents
MsgBox ("Import of CMS AR Data is Complete - Go To OrderDates to Update Billing Date (U)"), vbInformation + vbOKOnly, "Import Complete"
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module ImportCMSAR " & gstrMODULE
Call ErrorHandler2
gstrMODULE = ""
Close #1
Exit Sub
End Sub
Private Sub FixAPH()
Dim oRS As Recordset, strSQL As String, strJCCODE As String, strVENDOR As String, strINVOICE As String
Dim oRSS As Recordset, strSQLL As String, strJCCode2 As String, strV2 As String, strI2 As String
strSQL = "SELECT VendorNumber, InvoiceNumber, JobNumber FROM APH_JobDistDetail WHERE JobNumber = ' '"
' strSQL = "SELECT VendorNumber, InvoiceNumber, JobNumber FROM APH_JobDistDetail ORDER By VendorNumber, InvoiceNumber, JobNumber"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strJCCODE = Trim(Field2Str(oRS!JobNumber))
If strJCCODE = "" Then
strVENDOR = Field2Str(oRS!VendorNumber)
strINVOICE = Field2Str(oRS!InvoiceNumber)
strSQLL = "SELECT VendorNumber, InvoiceNumber, JobNumber FROM APH_JobDistDetail WHERE VendorNumber = '"
strSQLL = strSQLL & strVENDOR & "' AND InvoiceNumber = '" & strINVOICE & "' AND JobNumber <> ''"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSS.EOF Then
strJCCode2 = Field2Str(oRSS!JobNumber)
strV2 = Field2Str(oRSS!VendorNumber)
strI2 = Field2Str(oRSS!InvoiceNumber)
oRS!JobNumber = strJCCode2
oRS.Update
oRSS.Close
End If
oRS.MoveNext
End If
Loop
End If
oRS.Close
MsgBox "AP_JobDistDetail JCCode has been updated.", vbOKOnly, "Completed"
End Sub
Private Sub FixARH()
Dim oRS As Recordset, strSQL As String, strJCCODE As String, strCustomer As String, strINVOICE As String
Dim oRSS As Recordset, strSQLL As String, strJCCode2 As String, strV2 As String, strI2 As String, intCOUNT As Long
strSQL = "SELECT CustomerNumber, InvoiceNumber, JobNumber FROM ARN_InvHistoryHeader WHERE JobNumber = ' '"
' strSQL = "SELECT CustomerNumber, InvoiceNumber, JobNumber FROM APH_JobDistDetail ORDER By CustomerNumber, InvoiceNumber, JobNumber"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strJCCODE = Trim(Field2Str(oRS!JobNumber))
If strJCCODE = "" Then
strCustomer = Field2Str(oRS!CustomerNumber)
strINVOICE = Field2Str(oRS!InvoiceNumber)
strSQLL = "SELECT CustomerNumber, InvoiceNumber, JobNumber FROM ARN_InvHistoryHeader WHERE CustomerNumber = '"
strSQLL = strSQLL & strCustomer & "' AND InvoiceNumber = '" & strINVOICE & "' AND JobNumber <> ''"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSS.EOF Then
intCOUNT = oRSS.RecordCount
strJCCode2 = Field2Str(oRSS!JobNumber)
strV2 = Field2Str(oRSS!CustomerNumber)
strI2 = Field2Str(oRSS!InvoiceNumber)
oRS!JobNumber = strJCCode2
oRS.Update
oRSS.Close
End If
oRS.MoveNext
End If
Loop
End If
oRS.Close
MsgBox "ARN_InvHistoryHeader JCCode has been updated.", vbOKOnly, "Completed"
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 cmdCrewsNew_Click()
frmCrewsOLD.Show 1
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 = "JDV" 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
Call FixBilling
' Call FixLOTOptionCnt
' Call FixOpenPR2
'' 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 Opening Percentage 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 cmdFJCCode_Click()
Dim oRSJC As Recordset, strSQL As String
Dim oRSP As Recordset, strSQLP As String
Dim strProjLot, strPROJDESC As String
If Len(txtSJCCode) > 0 Then
txtSCode.Enabled = False
txtSContain.Enabled = False
txtSName.Enabled = False
strSQL = "SELECT * FROM tblLOTINFO WHERE JobCost = '" & txtSJCCode & "'"
Set oRSJC = New Recordset
oRSJC.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSJC.EOF Then
strSQLP = "SELECT * FROM tblPROJECT WHERE Proj_ID = " & oRSJC!PROJ_ID
Set oRSP = New Recordset
oRSP.Open strSQLP, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
lblProjCode.FontSize = 8
strProjLot = Trim(Field2Str(oRSP!Proj_Code)) & Trim(Field2Str(oRSJC!lot_no))
strPROJDESC = Trim(Field2Str(oRSP!Proj_Desc))
lblProjCode.Visible = True
lblDesc.Visible = True
lblProjCode.ForeColor = &HFF&
lblDesc.ForeColor = &HFF&
lblProjCode = strProjLot & " -- " & Trim(Field2Str(oRSP!Proj_Cont)) & " -- " & strPROJDESC
lblDesc = txtSJCCode & " -- " & Trim(Field2Str(oRSJC!address))
End If
Else
Exit Sub
End If
Else
MsgBox "A Job Cost Number Must Be Entered", , "No JC Number"
txtSJCCode.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 = "JDV" 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 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, strJCNumber As String
Dim oRS As Recordset, strNOTES As String
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, lotnotes FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
With oRS
strNOTES = Field2Str(!lotnotes)
strJCNumber = Field2Str(!jobcost)
If strJCNumber = "" Then
strJCNumber = " NO JC NUMBER"
End If
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
!lotnotes = strNOTES & " Old JC Number " & strJCNumber
!jobcost = UCase$(Field2Str(strJC))
' !notes =
.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()
' Call ListChanges
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 cmdPOBill_Click()
Dim strTEST As String
' MsgBox "This Feature Is Not Functioning", vbOKOnly, "Not Working"
' Exit Sub
If lstLots.ListCount > 0 Then
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
' Load frmPOWOLot
' frmPOWOLot.chkADD = vbChecked
frmWOList.Show 1
' frmPOWOLot.Show 1
' frmPOWOLot.chkADD = vbTrue
Else
MsgBox "You Must Display And Select A Lot To Process A PO/WO", vbOKOnly, "Select A Lot"
gintLOTID = 0
gintPROJID = 0
End If
' If LotFind() Then
' lstLots.ToolTipText = Field2Str(moRS!jobcost)
' strTEST = lstLots.ToolTipText
' End If
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 ListChanges()
Dim oRS As Recordset, strSQL As String, strMSG As String
strSQL = "SELECT * FROM tblCHANGE WHERE ChgDate > #" & gdteUPDATE & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' If Not oRS.EOF Then
Do Until oRS.EOF
strMSG = strMSG & Field2Str(oRS!Chgdate) & " " & Field2Str(oRS!CHgInfo)
strMSG = strMSG & vbCrLf & vbCrLf
If Not oRS.EOF Then
oRS.MoveNext
End If
Loop
' End If
MsgBox strMSG, vbOKOnly, "Click OK To Continue"
End Sub
Private Sub cmdPrintJCRpt_Click()
Dim strSQL As String, strYN As String
On Error GoTo Error_EH
strYN = MsgBox("Do You Want To Print Report", vbYesNo, "Print?")
If strYN = vbYes Then
mboolREPORT = True
mboolWINDOW = False
Else
mboolWINDOW = True
mboolREPORT = False
End If
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
gintCOPY = 1
crMain.Reset
strSQL = "{tblJOBCOST_RPT.LOT_ID} = " & gintLOTID
crMain.ReportFileName = App.Path & "\jobcost.rpt"
crMain.SelectionFormula = strSQL
crMain.CopiesToPrinter = gintCOPY
If mboolWINDOW = True Then
crMain.Destination = crptToWindow
End If
If mboolREPORT = True Then
crMain.Destination = crptToPrinter
End If
crMain.Action = 1
crMain.Reset
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crMain.ReportFileName = App.Path & "\jobcost2.rpt"
crMain.SelectionFormula = strSQL
crMain.CopiesToPrinter = gintCOPY
If mboolWINDOW = True Then
crMain.Destination = crptToWindow
End If
If mboolREPORT = True Then
crMain.Destination = crptToPrinter
End If
crMain.Action = 1
' 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
crMain.Reset
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()
gboolSYN = False
gboolBAG = False
gintLOTID = 0
gintPROJID = 0
txtSCode.Enabled = True
txtSName.Enabled = True
txtSContain.Enabled = True
txtSCode = ""
txtSName = ""
txtSJCCode = ""
' txtSCode.Text = ""
' txtSName.Text = ""
txtSContain = ""
lstProject.Clear
lstLots.Clear
lstContains.Clear
lblProjCode.FontSize = 10
lblProjCode.Caption = ""
lblDesc = ""
lblDesc.ForeColor = &H80000012
lblProjCode.ForeColor = &H80000012
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
cmdFJCCode.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 = True
' cmdDates.Visible = False
' cmdYardOrder.Visible = False
cmdYardOrder.Visible = True
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 = True
' cmdDates.Visible = False
' cmdYardOrder.Visible = False
cmdYardOrder.Visible = True
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 = True
' cmdDates.Visible = False
' cmdYardOrder.Visible = False
cmdYardOrder.Visible = True
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()
Dim oRS As Recordset, strSQL As String
Me.Move (Screen.Width - Me.Width - 600) / 2, (Screen.Height - Me.Height) / 2
strSQL = "SELECT * FROM tblSYSINFO"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
gdteUPDATE = oRS!LastUP - 45
cmdNewSearch.Enabled = False
If gbytSECURITY = 6 Then
mnuContractor.Enabled = True
' mnuProject.Enabled = True
cmdShip.Visible = True
' mnuJCTrans.Enabled = True
mnuAddPPay.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
cmdPOBill.Enabled = True
' mnuJCTrans.Enabled = True
End If
If gbytSECURITY = 1 Then
mnuUser.Enabled = True
mnuRCrew.Enabled = True
mnuCrew.Enabled = True
cmdPOBill.Enabled = True
cmdPOList.Visible = True
mnuUpCheck.Visible = True
mnuTransfer.Enabled = True
' mnuJCTrans.Enabled = True
cmdInvoice.Visible = True
mnuVoid.Visible = True
mnuPosPay.Enabled = True
mnuAddPPay.Enabled = 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
cmdHourly.Enabled = True
mnuCMSAP.Visible = True
mnuCMSAP.Enabled = True
mnuCMSAR.Visible = True
mnuCMSAR.Enabled = True
mnuCMSPP.Visible = True
mnuCMSPP.Enabled = 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
If gstrLOGIN = "TDR" Then
mnuRCrew.Enabled = True
End If
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)
' gintLOTID = lstLots.ItemData(lstLots.ListIndex)
' gintPROJID = lstProject.ItemData(lstProject.ListIndex)
Else
gintLOTID = 0
End If
If LotFind() Then
If moRS!SCert Then
lstLots.ToolTipText = Field2Str(moRS!jobcost) & " --- " & Field2Str(moRS!Lot_ID) & " --- " & " Stucco Cert Done"
strTEST = lstLots.ToolTipText
Else
lstLots.ToolTipText = Field2Str(moRS!jobcost) & " --- " & Field2Str(moRS!Lot_ID)
strTEST = lstLots.ToolTipText
End If
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 (mm/dd/yyyy)", "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 - 45
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 FixLOTOptionCnt()
Dim strSQL As String, strDate As String
Dim strSQLL As String, oRSO As Recordset, oRSP As Recordset
Dim lngCNT As Long, lngPOptID As Long
lngCNT = 0
strSQL = "SELECT * FROM tblPOption" 'WHERE OPTID = " & lstOptions.ItemData(lstOptions.ListIndex)
Set oRSP = New Recordset
oRSP.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
oRSP.MoveFirst
' If moRSOpt.EOF Then
' FormFindOpt = False
' Else
' strDate = Field2Str(moRSOpt!effdate)
' If Len(strDate) = 0 Then
' moRSOpt!effdate = Field2Str(txtEffDate)
' moRSOpt.Update
' Call AddOptBill3
' End If
Do Until lngCNT = oRSP.RecordCount
lngPOptID = Field2Str2(oRSP!OPTID)
strSQLL = "SELECT * FROM tblLOPTION WHERE OPT_ID = " & lngPOptID
Set oRSO = New Recordset
oRSO.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSO.EOF Then
' mboolOPTUSED = True
oRSP!USED = vbTrue
oRSP.Update
Else
' mboolOPTUSED = False
End If
lngCNT = lngCNT + 1
oRSP.MoveNext
Loop
' Exit Function
MsgBox "POption USED Field Update Is Completed", vbOKOnly
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim strSQL As String, intBOOKMARK As Integer
' Q Finish processing on an AR transfer to CMS
' U Reprint Order Check List Report
' R Open The Repair Scheduling Screen - Only For Address Lookup
' Z Update The Job Cost Code in AP History File
' X Update The Job Cost Code in AR History File
' T Show The PaySheets That Have Been Printed For The Highlighted Lot
' Y Mark The HiLited lot as a test lot and to not print in selected lists
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 = vbKeyI And gbytSECURITY = 1 Then ' Change INV_NO in TOMatrl to a String
If CtrlDown Then
Call UpTOMatrl
End If
End If
If KeyCode = vbKeyL And gbytSECURITY = 1 Then ' Change INV_NO in LotMatrl to a string
If CtrlDown Then
Call UpLOTMatrl
End If
End If
If KeyCode = vbKeyY And mboolMARK Then 'gbytSECURITY = 1 Then ' Change INV_NO in LotMatrl to a string
If CtrlDown Then
moRS!Skip = True
moRS.Update
End If
End If
If KeyCode = vbKeyR Then
If CtrlDown Then
If lstContains.Visible = False Then
MsgBox "This Only Works With The SEARCH ADDRESS Lookup", vbOKOnly, "Invalid Lookup"
Exit Sub
End If
lstContains.col = 0
gintLOTID = lstContains.ColText
' gintLOTID = lstLots.ItemData(lstLots.ListIndex)
frmRepairLot.Show 1
End If
End If
If KeyCode = vbKeyZ Then ' Update The Job Cost Code in AP History File
If CtrlDown Then
Call FixAPH
End If
End If
If KeyCode = vbKeyX Then ' Update The Job Cost Code in AR History File
If CtrlDown Then
Call FixARH
End If
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 the Pay SHeet information
If CtrlDown Then
If lstLots.Visible = False Then
MsgBox "Need To Select A Lot First", vbOKOnly, "Invalid Selection"
Exit Sub
End If
intBOOKMARK = lstLots.ListIndex
gintPROJID = Field2Str2(lstProject.ItemData(lstProject.ListIndex))
gintLOTID = Field2Str2(lstLots.ItemData(lstLots.ListIndex))
frmPaySheet.Show 1
lstLots.ListIndex = intBOOKMARK
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 = vbKeyA And (gbytSECURITY < 3 Or gstrLOGIN = "JDV") Then ' Fix BIlling Date
If CtrlDown Then
Call cmdNewSearch_Click
lblCALC.Visible = True
Call cmdFixBill_Click
lblCALC.Visible = False
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
If KeyCode = vbKeyQ And (gbytSECURITY < 3) Then ' Complete the setup of a transfer to cms
If CtrlDown Then
Call CMSTransfer ' this command must be removed for production
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 mnuABTPosPayC_Click()
Call ABTPosPayC
End Sub
Private Sub mnuABTPosPayS_Click()
Call ABTPosPayS
End Sub
Private Sub mnuABTPosPayV_Click()
Call ABTPosPayV
End Sub
Private Sub mnuAck_Click()
frmAck.Show 1
End Sub
Private Sub mnuAddPPayS_Click()
frmPosPayS.Show 1
End Sub
Private Sub mnuAddPPayV_Click()
frmPosPayV.Show 1
End Sub
Private Sub mnuAddPPayC_Click()
frmPosPayC.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 mnuAREdit2_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
' cdMain.Action = 5
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 mnuCMSAP_Click()
Call ImportCMSAP
End Sub
Private Sub mnuCMSAR_Click()
Call ImportCMSAR
End Sub
Private Sub mnuCMSPPSW_Click()
Call ImportCMSPPSW
End Sub
Private Sub mnuCMSPPVW_Click()
Call ImportCMSPPVW
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()
frmARMaster.Show 1
End Sub
Private Sub mnuAPUPDATE_Click()
frmAPMaster.Show 1
End Sub
Private Sub mnuARUPDATExx_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 mnuAPUPDATExx_Click()
Dim strSQL As String, strSELECT As String, strTEST As String
Dim oRS As Recordset, oRSS As Recordset
' If Not 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()
frmInvType.Show 1
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 mnuLathList"
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 ABTPosPayV()
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, strMAX As String
Dim strBegDate As String, strEndDate As String, strFILE2 As String
Dim strBegDate2 As String, strEndDate2 As String
Dim intCOUNT As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
strMAX = FindMax("tblPosPayVWP", "Sequence")
strMAX = Val(strMAX) + 1
' 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 = "8"
' 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 tblPosPayVWP WHERE Not SUBMIT" ' TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' If oRS.EOF Then
' MsgBox "Did not open bank code", vbOKOnly
' Exit Sub
' End If
strName = Space(34)
strFILE2 = "PosPay" & strMAX & ".TXT"
strFile = "G:\A_PosPay\PosPayVW\" & strFILE2
' strFile = "C:\AZBank\PosPay.txt"
intCOUNT = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CKDate, "MMDDYY")
strAMT = Format(Field2Str(!CKAmt), "0000000.00")
strCHECK = Format(!CKNumber, "0000000000")
' strName = Field2Str(!CheckPayeeName)
strEXPORT = "C008009361183601 RA " & strCHECK & strAMT & strDate & strName
' If strDate >= strBegDate2 And strDate <= strEndDate2 Then
intCOUNT = intCOUNT + 1
dblTotal = dblTotal + Field2Str2(!CKAmt)
Print #1, strEXPORT
' End If
!Submit = True
!SubDate = Date
!sequence = strMAX
!User = gstrLOGIN
.Update
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File --> " & strFILE2 & " <--" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & " 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 ABTPosPayV"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub ABTPosPayS()
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, strMAX As String
Dim strBegDate As String, strEndDate As String, strFILE2 As String
Dim strBegDate2 As String, strEndDate2 As String
Dim intCOUNT As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
strMAX = FindMax("tblPosPaySWI", "Sequence")
strMAX = Val(strMAX) + 1
' 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 tblPosPaySWI WHERE Not SUBMIT" ' TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' If oRS.EOF Then
' MsgBox "Did not open bank code", vbOKOnly
' Exit Sub
' End If
strName = Space(34)
strFILE2 = "PosPay" & strMAX & ".TXT"
strFile = "G:\A_PosPay\PosPaySW\" & strFILE2
' strFile = "C:\AZBank\PosPay.txt"
intCOUNT = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CKDate, "MMDDYY")
strAMT = Format(Field2Str(!CKAmt), "0000000.00")
strCHECK = Format(!CKNumber, "0000000000")
' strName = Field2Str(!CheckPayeeName)
strEXPORT = "C007009361131056 RA " & strCHECK & strAMT & strDate & strName
' If strDate >= strBegDate2 And strDate <= strEndDate2 Then
intCOUNT = intCOUNT + 1
dblTotal = dblTotal + Field2Str2(!CKAmt)
Print #1, strEXPORT
' End If
!Submit = True
!SubDate = Date
!sequence = strMAX
!User = gstrLOGIN
.Update
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File --> " & strFILE2 & " <--" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & " 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 ABTPosPayS"
' Call ErrorHandler(oRS.ActiveConnection)
Call ErrorHandler2
gstrMODULE = ""
End Sub
Private Sub ABTPosPayC()
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, strMAX As String
Dim strBegDate As String, strEndDate As String, strFILE2 As String
Dim strBegDate2 As String, strEndDate2 As String
Dim intCOUNT As Integer, dblTotal As Double, strBANK As String
On Error GoTo Error_EH
strMAX = FindMax("tblPosPayCRD", "Sequence")
strMAX = Val(strMAX) + 1
' 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 tblPosPayCRD WHERE Not SUBMIT" ' TransactionType = 'C' and BankCode = '4' and Amount > 0 and ClearedBank = 'N'" ' where checktransdate >= " & strBegDate & " and checktransdate <= " & strEndDate
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' If oRS.EOF Then
' MsgBox "Did not open bank code", vbOKOnly
' Exit Sub
' End If
strName = Space(34)
strFILE2 = "PosPay" & strMAX & ".TXT"
strFile = "G:\A_PosPay\PosPayCR\" & strFILE2
' strFile = "C:\AZBank\PosPay.txt"
intCOUNT = 0
dblTotal = 0
Open strFile For Output As #1
Do Until oRS.EOF
With oRS
strDate = Format(!CKDate, "MMDDYY")
strAMT = Format(Field2Str(!CKAmt), "0000000.00")
strCHECK = Format(!CKNumber, "0000000000")
' strName = Field2Str(!CheckPayeeName)
strEXPORT = "C007009361131080 RA " & strCHECK & strAMT & strDate & strName
' If strDate >= strBegDate2 And strDate <= strEndDate2 Then
intCOUNT = intCOUNT + 1
dblTotal = dblTotal + Field2Str2(!CKAmt)
Print #1, strEXPORT
' End If
!Submit = True
!SubDate = Date
!sequence = strMAX
!User = gstrLOGIN
.Update
End With
oRS.MoveNext
Loop
strMSG = "PosPay Export File --> " & strFILE2 & " <--" & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & " 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 ABTPosPayS"
' 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, strMSG As String
strMSG = "Are You Sure You Are Ready To Setup The Invoice Transfer?"
strMSG = strMSG & vbCrLf & "If You Answer YES And Have Not Made Corrections, The File Will Be Lost"
strMSG = strMSG & vbCrLf & "And You Will Not Be Able To Transfer To CMS"
intYN = MsgBox(strMSG, vbYesNo + vbQuestion, "Are You Sure?")
If intYN = vbNo Then
Exit Sub
End If
Call SetupTransfer
' Call CMSTransfer ' this command must be removed for production
' MsgBox "Invoices are now ready for Transfer - Go to CMS to Import", vbOKOnly, "Goto CMS"
' 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 CMS 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 CMSAPTransfer
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 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()
mboolMARK = True
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
' 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 = "JDV" 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 = "JDV" 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 = "JDV" 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, JobCost 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 & Left(strProj_Cont, 24) & 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) & vbTab & Field2Str(oRS!jobcost)
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, intCNT As Integer, intCOUNT As Integer
Dim strSQL As String, strSELECT As String, strCODE As String
mboolSHOW = False
intCOUNT = 1
lstProject.Visible = True
lstProject.Width = 4035
lstLots.Visible = False
lblProjCode.Visible = True
' lblDesc.Visible = True
strCODE = Trim$(txtSCode.Text)
' strSELECT = "proj_code LIKE '" & strCode & "*'" ' & """"
' strSELECT = "proj_code LIKE '" & strCode & "%'" ' & """"
' strSQL = "SELECT Proj_id, Proj_desc, proj_code FROM tblProject "
' strSQL = "SELECT Proj_id, Proj_desc, proj_code FROM tblProject WHERE Proj_Code = '" & strCode & "%'"
strSQL = "SELECT Proj_id, Proj_desc, proj_code FROM tblProject WHERE Proj_Code LIKE '" & strCODE & "%'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
' oRS.Filter = strSELECT
' intCNT = oRS.RecordCount
lstProject.Clear
Do Until oRS.EOF
lstProject.AddItem RTrim(oRS("Proj_desc")) ' & " -- " & oRS!Desc
lstProject.ItemData(lstProject.NewIndex) = oRS("Proj_id")
intCOUNT = intCOUNT + 1
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_id, proj_code, proj_cont, jccode, proj_desc, bag100, pomax, inv_type, p_sw, 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
lstProject.ToolTipText = Field2Str(moRSProj!PROJ_ID)
If moRSProj!bag100 Or moRSProj!P_SW Then
' 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, intCNT As Integer
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 & "*'" ' & """"
strSELECT = "proj_desc LIKE '" & strCODE & "%'" ' & """"
strSQL = "SELECT Proj_id, Proj_desc FROM tblProject WHERE proj_desc LIKE '" & strCODE & "%'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' intCNT = oRS.RecordCount
' oRS.Filter = strSELECT
lstProject.Clear
Do Until oRS.EOF
' intCNT = oRS.RecordCount
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 txtSJCCode_Change()
cmdNewSearch.Enabled = True
End Sub
Private Sub txtSJCCode_GotFocus()
Call FieldSelect(txtSJCCode)
End Sub
Private Sub txtSJCCode_LostFocus()
txtSJCCode = UCase(txtSJCCode)
If Len(txtSJCCode) > 0 Then
cmdFJCCode.Enabled = True
cmdFJCCode.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
Dim strYN As String, strMSG As String, intCNT As Integer
Dim strYN2 As String, strMSG2 As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARINVOICE WHERE ready ORDER By Invoice_NO, DETNUM" '**** Need to make a report showing this information before processng
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
intCNT = oRS.RecordCount
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 = Field2Str(oRS!Description)
' !Description = Left$(Field2Str(oRS!Description), 30)
!price = oRS!price
!amount = oRS!amount
!ready = True
!shipping = Left$(Field2Str(oRS!project), 15)
!comment = Field2Str(oRS!po_num)
' !comment = "LOT " & oRS!lot_no & "-" & Left$(Field2Str(oRS!address), 20)
!taxcode = UCase(oRS!taxcode)
!CodeDesc = Field2Str(oRS!CodeDesc)
!DETNUM = oRS!DETNUM
!DETTOT = oRS!DETNUM
!State = Field2Str(oRS!State)
!zip = Field2Str(oRS!zip)
!City = Field2Str(oRS!City)
!UDF2 = "LOT " & oRS!lot_no & "-" & Left$(Trim$(Field2Str(oRS!address)), 38)
' !UDF2 = Trim$(Field2Str(oRS!projcode)) & "-" & Left$(Trim$(Field2Str(oRS!address)), 43)
.Update
' oRS!ready = False
' oRS!done = True
' oRS.Update
oRS.MoveNext
End With
Loop
strMSG = "Do You Want To Print An Edit Report For This Transfer Batch? Y/N"
strYN = MsgBox(strMSG, vbYesNo, "Print Edit Report?")
If strYN = vbYes Then
Call mnuAREdit2_Click
End If
strMSG2 = "Click On YES To Continue CMS Transfer, NO To Exit And Make Corrections"
strYN2 = MsgBox(strMSG2, vbDefaultButton2 + vbYesNo)
' vbYesNo)
If strYN2 = vbYes Then
Call MarkDONE
' Call SetTransNumber
Call CMSTransfer
ElseIf strYN2 = vbNo Then
Exit Sub
End If
Exit Sub
Error_EH:
gstrMODULE = "Form MAIN - Module SetupTransfer"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub MarkDONE()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
Dim strYN As String, strMSG As String, intCNT As Integer
Dim strYN2 As String, strMSG2 As String
strSQL = "SELECT * FROM tblARINVOICE WHERE ready ORDER By Invoice_NO, DETNUM" '**** Need to make a report showing this information before processng
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRS.EOF
oRS!ready = False
oRS!done = True
oRS.Update
oRS.MoveNext
Loop
End Sub
Private Sub SetTransNumber()
Dim strSQL As String, strFIX As String, intMAX As Integer, strSQLL As String
Dim oRS As Recordset, oRSS As Recordset
Dim strINVNO1 As String, strINVNOHold As String
strSQL = "Select * FROM tblARTRANS ORDER By INVOICE_NO"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If oRS.EOF Then
MsgBox "No Invoices In The Transfer File - ReSelect", vbOKOnly, "No Invoices"
Exit Sub
End If
Do Until oRS.EOF
strINVNO1 = Field2Str(oRS!invoice_no)
If strINVNO1 <> strINVNOHold Then
strSQLL = "SELECT * FROM tblARTRANS WHERE INVOICE_NO = '" & strINVNO1 & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSS.EOF Then
intMAX = oRSS.RecordCount
End If
strFIX = "Update tblARTRANS SET DETTOT = " & intMAX & " WHERE INVOICE_NO = '" & strINVNO1 & "'"
goConn.Execute strFIX
' Else
strINVNOHold = strINVNO1
End If
oRS.MoveNext
Loop
End Sub
Private Sub SetupTransferTest()
Call SetTransNumber
End Sub
Private Sub SetupTransferOLD()
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 = UCase(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, strSql5 As String
Dim oRS As Recordset, oRSS As Recordset
Dim oRL As Recordset, oRP As Recordset, oRLL As Recordset
Dim strSQL3 As String, strSQL4 As String
Dim strDueDate As String
'*************************************
'******* Need to setup the sub routine to create the transfer file for CMS
'*************************************
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
' strSql5 = "SELECT lot_id, Lot_NO FROM tblLotInfo WHERE lot_id = " & oRL!Lot_ID
' Set oRLL = New Recordset
' oRLL.Open strSql5, goConn, adOpenForwardOnly, adLockReadOnly
Else
MsgBox "No Lot Found", vbOKOnly, "No Lot"
Exit Sub
End If
.AddNew
!invoice_no = oRS!Vend_Inv
' !invoice_no = oRS!sup_inv
' !customer_no = oRS!customer_no
!customer_no = "VALLEY"
!invoice_date = oRS!inv_date
!job_number = oRL!jobcost
' !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", 33, oRS!inv_date)
!disc_due_date = DateAdd("d", 33, 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)
' !DETNUM = oRS!DETNUM
' !DETTOT = oRS!DETNUM
!UDF2 = "Lot " & oRL!lot_no & "," & Left$(Trim$(Field2Str(oRL!address)), 38)
' !UDF2 = "Lot " & oRL!lot_no & ", " & Left$(Field2Str(oRL!address), 20)
!DETNUM = 0
!DETTOT = 0
.Update
oRS!ar = False
oRS!ar_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
Call CMSSWTransfer
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!Vend_Inv
' !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 SetupAPTransferTEST()
Call CMSAPTransfer
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, strJC As String, strPONM 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!Vend_Inv)
' !invoice_no = Field2Str2(oRS!sup_inv)
!Vendor_no = Left$(Field2Str(oRSP!Vendor_no), 7)
!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)
' !PO_NUMBER = Trim$((oRS!jobcost)) & Trim$((oRS!po_num))
!PO_NUMBER = Trim$(Field2Str(oRS!jobcost)) & Trim$(Field2Str(oRS!po_num))
!ready = True
.Update
oRS!ap = False
oRS!ap_trans = True
oRS.Update
oRS.MoveNext
End With
Loop
Call CMSAPTransfer
MsgBox "VWP Accounts Payable is now ready for Transfer - Go to CMS to Import", vbOKOnly, "Goto CMS"
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!Vend_Inv)
' !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
Private Sub FixOpenPR()
Dim oRS As Recordset, oRSS As Recordset, oRSMAX As Recordset
Dim oRT As Recordset, oRTT As Recordset, intResponse As Integer
Dim strBILL As String, strPBILL As String, oRB As Recordset, oRPB As Recordset
Dim strOpt As String, strOPTMAT As String, dblOPTID As Double
Dim strSQL As String, strSELECT As String, strMAX As String
Dim lngPROJID As Long, strMODELV As String
Dim dblMatCost As Double
strSELECT = "SELECT * FROM tblPlans" ' where proj_id = " & gintPROJID & " and mod_elv = '" & mstrMODEL & "'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRS.RecordCount > 0 Then
Do Until oRS.EOF
With oRS
lngPROJID = oRS!PROJ_ID
strMODELV = Field2Str(oRS!Mod_Elv)
strSQL = "SELECT * FROM tblTake where proj_id = " & lngPROJID & " and Pln_Elv = '" & strMODELV & "' AND Not SuperSede"
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!openpr = Field2Integer(oRSS!openpr)
oRS.Update
End If
End With
oRS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module FixOpenPR"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FixOpenPR2()
Dim oRS As Recordset, oRSS As Recordset, oRSMAX As Recordset
Dim oRT As Recordset, oRTT As Recordset, intResponse As Integer
Dim strBILL As String, strPBILL As String, oRB As Recordset, oRPB As Recordset
Dim strOpt As String, strOPTMAT As String, dblOPTID As Double
Dim strSQL As String, strSELECT As String, strMAX As String
Dim lngESTID As Long
Dim dblMatCost As Double
strSELECT = "SELECT * FROM tblLotInfo" ' where proj_id = " & gintPROJID & " and mod_elv = '" & mstrMODEL & "'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRS.RecordCount > 0 Then
Do Until oRS.EOF
If Not IsNull(oRS!est_id) Then
With oRS
lngESTID = oRS!est_id
strSQL = "SELECT * FROM tblPlans where EST_ID = " & lngESTID '& " and Pln_Elv = '" & strMODELV & "'"
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!openpr = Field2Integer(oRSS!openpr)
oRS.Update
End If
End With
End If
oRS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Main - Module FixOpenPR2"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
'Remove cmdExport_Click if there are no problems with exporting to cms
'Private Sub cmdExport_Click()
'Dim strSQL As String, oRS As Recordset, strSQLL As String, oRSS As Recordset
'Dim strFLAG As String, strSTOCKNO As String, strDESC As String
'Dim strONHAND As String, strCOUNT As String, strCost1 As String
'Dim strCost2 As String, strNumber1 As String, strNumber2 As String, strNumber3 As String
'Dim strINVDATE As String, strDueDate As String, strDISCDATE As String
'Dim strCHKDATE As String, strGLDATE As String, strFILLER As String
'Dim strLinType As String, strSTOCK As String, strFILLER1 As String
'Dim strEXPDate As String, strQTY As String, strCOST As String
'Dim strFILLER2 As String, lngPOID As Long, intYN As Integer, lngPOID2 As Long
'Dim strFile As String, strLINE1 As String, strLINE2 As String
'Dim strTDATE1, strTDATE2, strDept1, strDept2, strDept3 As String
'Dim dblRU1D1, dblOT1U1D1, dblVU1D1, dblHU1D1, dblATG1 As Double
'Dim dblRU2D1, dblOT1U2D1, dblVU2D1, dblHU2D1, dblATG2 As Double
'Dim dblRU1D2, dblOT1U1D2, dblVU1D2, dblHU1D2 As Double
'Dim dblRU2D2, dblOT1U2D2, dblVU2D2, dblHU2D2 As Double
'Dim dblRU1D3, dblOT1U1D3, dblVU1D3, dblHU1D3 As Double
'Dim dblRU2D3, dblOT1U2D3, dblVU2D3, dblHU2D3 As Double
'Dim strEMPNO As String
'Dim FSys As New FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
'Dim dblCHANGE As Double, lngDIF As Long, strMSG As String
'Dim lngCount As Long, lngSALES As Long, lngPO As Long
'Dim strMONTH As String, strDAY As String, strSEC As String
'Dim dteWK1, dteWK2 As Date
'Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
' dteWK2 = DTPickerDateEnd
' dteWK1 = DTPickerDateEnd - 7
' strTDATE1 = Format(dteWK2, "YYYYMMDD ")
' strTDATE2 = Format(dteWK2, "YYYYMMDD ")
'' dteWK1 = mdteENDDATE
'' dteWK2 = mdteENDDATE - 7
'' strDAY = Format(Day(Date), "00")
'' strMONTH = Format(Month(Date), "00")
' strSQLLL = "SELECT * FROM tblSummary WHERE PPID = " & mintPPID
' strSQLLL = "SELECT * FROM tblSummary WHERE not NoPrint AND PPID = " & mintPPID & " ORDER BY DEPT1, CMSEMP"
' Set oRSSS = New Recordset
' oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
'' strSTORE = gstrCOMPANY & "DATA"
' strEXT = "E:\CMSWIN\PREXT." & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' strEXT = "c:\CMSWIN\PREXT." & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' Set TStream = FSys.CreateTextFile(strEXT, True)
' Do Until oRSSS.EOF
' strEMPNO = Field2Str(oRSSS!CMSEmp)
' dblRU1D1 = Field2Str2(oRSSS!D1W1)
' dblRU2D1 = Field2Str2(oRSSS!D1W2)
' dblRU1D2 = Field2Str2(oRSSS!D2W1)
' dblRU2D2 = Field2Str2(oRSSS!D2W2)
' dblRU1D3 = Field2Str2(oRSSS!D3W1)
' dblRU2D3 = Field2Str2(oRSSS!D3W2)
' If dblRU1D1 > 0 Or dblRU2D1 > 0 Then
' dblOT1U1D1 = Field2Str2(oRSSS!OTW1)
' dblOT1U2D1 = Field2Str2(oRSSS!OTW2)
' dblHU1D1 = Field2Str2(oRSSS!HW1)
' dblHU2D1 = Field2Str2(oRSSS!HW2)
' dblVU1D1 = Field2Str2(oRSSS!VW1)
' dblVU2D1 = Field2Str2(oRSSS!VW2)
' dblATG1 = Field2Str2(oRSSS!ATGW1)
' dblATG2 = Field2Str2(oRSSS!ATGW2)
' strDept1 = Field2Str(oRSSS!Dept1)
' strRate1 = Field2Str(oRSSS!Rate1)
'
'' strLINE1 = strEMPNO & vbTab & strTDATE1 & vbTab & strDEPT1 & vbTab & vbTab & Format(dblRU1D1, "00000000.0000")
' strLINE1 = strEMPNO & vbTab & strTDATE1 & vbTab & strDept1 & vbTab & mstrRate1 & vbTab & Format(dblRU1D1, "00000000.0000")
' strLINE1 = strLINE1 & vbTab & Format(dblOT1U1D1, "00000000.0000") & vbTab & vbTab & Format(dblVU1D1, "00000000.0000")
' strLINE1 = strLINE1 & vbTab & Format(dblHU1D1, "00000000.0000") & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab & Format(dblATG1, "00000000.0000") & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE1)
'' strLINE2 = strEMPNO & vbTab & strTDATE2 & vbTab & strDEPT1 & vbTab & vbTab & Format(dblRU2D1, "00000000.0000")
' strLINE2 = strEMPNO & vbTab & strTDATE2 & vbTab & strDept1 & vbTab & mstrRate1 & vbTab & Format(dblRU2D1, "00000000.0000")
' strLINE2 = strLINE2 & vbTab & Format(dblOT1U2D1, "00000000.0000") & vbTab & vbTab & Format(dblVU2D1, "00000000.0000")
' strLINE2 = strLINE2 & vbTab & Format(dblHU2D1, "00000000.0000") & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE2 = strLINE2 & vbTab & vbTab & vbTab & Format(dblATG2, "00000000.0000") & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE2)
' End If
' If dblRU1D2 > 0 Or dblRU2D2 > 0 Then
' strDept2 = Field2Str(oRSSS!Dept2)
' strRate2 = Field2Str(oRSSS!Rate2)
' strLINE1 = strEMPNO & vbTab & strTDATE1 & vbTab & strDept2 & vbTab & strRate2 & vbTab & Format(dblRU1D2, "00000000.0000")
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE1)
' strLINE2 = strEMPNO & vbTab & strTDATE2 & vbTab & strDept2 & vbTab & strRate2 & vbTab & Format(dblRU2D2, "00000000.0000")
' strLINE2 = strLINE2 & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE2 = strLINE2 & vbTab & vbTab & vbTab & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE2)
' End If
' If dblRU1D3 > 0 Or dblRU2D3 > 0 Then
' strDept3 = Field2Str(oRSSS!Dept3)
' strRate3 = Field2Str(oRSSS!Rate3)
' strLINE1 = strEMPNO & vbTab & strTDATE1 & vbTab & strDept3 & vbTab & strRate3 & vbTab & Format(dblRU1D3, "00000000.0000")
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE1 = strLINE1 & vbTab & vbTab & vbTab & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE1)
' strLINE2 = strEMPNO & vbTab & strTDATE2 & vbTab & strDept3 & vbTab & strRate3 & vbTab & Format(dblRU2D3, "00000000.0000")
' strLINE2 = strLINE2 & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strLINE2 = strLINE2 & vbTab & vbTab & vbTab & vbTab & vbTab '& vbCrLf
' TStream.WriteLine (strLINE2)
' End If
' oRSSS!lock = vbChecked
' oRSSS.Update
' oRSSS.MoveNext
' Loop
' strMSG = "Export Complete - Go To CMS Payroll and IMPORT DAILY using an External File" ', vbInformation + vbOKOnly, "Export Complete")
' strMSG = strMSG & vbCrLf & "File Name: " & strEXT
' MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
' Close #1
'End Sub
Private Sub CMSTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strPONUM, strDept, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long
Dim strMONTH As String, strDAY As String, strSEC As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strHR As String
Dim strCODEDESC As String, strSHIPINFO As String, bytQTY As Byte
Dim strCITY, strZIP, strSTATE As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
If strHR > 12 Then
strHR = Field2Str2(strHR) - 12
strHR = Format(strHR, "00")
End If
strFile = "OE" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblARTrans ORDER BY INVOICE_NO, DETNUM"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
strLastInvNo = ""
Do Until oRSSS.EOF
strINVNO = oRSSS!invoice_no
If strLastInvNo = strINVNO Then
GoTo Detail
End If
strHeadID = "H"
strCUSTNo = oRSSS!customer_no
strSHIPADD = oRSSS!shipping
strCHG = "3"
strTType = "0"
strLastInvNo = strINVNO
strPONUM = Field2Str(oRSSS!comment)
' strPONUM = ""
strDept = "Dept01"
strTaxCode = oRSSS!taxcode
strINVDATE = oRSSS!invoice_date
strShipDate = oRSSS!invoice_date
strCITY = Field2Str(oRSSS!City)
strSTATE = Field2Str(oRSSS!State)
strZIP = Field2Str(oRSSS!zip)
strUDF1 = oRSSS!job_number
strUDF2 = oRSSS!UDF2
strUDF2 = Left(strUDF2, 34)
strCODEDESC = Field2Str(oRSSS!CodeDesc)
strSHIPINFO = Left(strCODEDESC, 34)
'*****need to remove strPONUM from position after the strINVNO field
' strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strSHIPINFO & vbTab & strSHIPINFO & vbTab & strUDF2 & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strSHIPINFO & vbTab & strSHIPINFO & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHEADER & strCHG & vbTab & strTType & vbTab & strINVNO & vbTab & vbTab & vbTab & strDept & vbTab
' strHEADER = strHEADER & vbTab & strTaxCode & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHEADER & vbTab & strINVDATE & vbTab & strINVDATE & vbTab & strShipDate & vbTab & strUDF1 & vbTab & strUDF2
strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strSHIPINFO & vbTab & strUDF2 & vbTab & vbTab & strCITY & vbTab & strSTATE & vbTab & strZIP & vbTab & vbTab
strHEADER = strHEADER & strCHG & vbTab & strTType & vbTab & strINVNO & vbTab & strPONUM & vbTab & vbTab & strDept & vbTab
strHEADER = strHEADER & vbTab & strTaxCode & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
strHEADER = strHEADER & vbTab & strINVDATE & vbTab & strINVDATE & vbTab & strShipDate & vbTab & strUDF1 & vbTab & strUDF2
TStream.WriteLine (strHEADER)
Detail:
strDetID = "D"
strSTOCK = oRSSS!sales_code
strDESC = oRSSS!Description
strTXABLE = "1"
If strSTOCK = "WINS" Then
strLType = "11"
strOQty = "-1"
strSQty = "-1"
strPRICE = (oRSSS!price * -1)
Else
strLType = "1"
strOQty = "1"
strSQty = "1"
strPRICE = oRSSS!price
End If
' strOQty = oRSSS!Quantity
' strSQty = oRSSS!Quantity
' strPRICE = oRSSS!price
strDETAIL = strDetID & vbTab & strLType & vbTab & strSTOCK & vbTab & vbTab & strDESC ' & vbTab & Format(dblRU2D1, "00000000.0000")
strDETAIL = strDETAIL & vbTab & vbTab & vbTab & strTaxCode & vbTab & vbTab & strTXABLE
strDETAIL = strDETAIL & vbTab & vbTab & vbTab & vbTab & strOQty & vbTab & strSQty & vbTab & vbTab & strPRICE 'vbTab & vbTab & vbTab & vbTab
TStream.WriteLine (strDETAIL)
oRSSS.Update
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Sales Module then "
strMSG = strMSG & vbCrLf & "Order Entry - GENERATE ORDERS Using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
End Sub
Private Sub CMSAPTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strPONUM, strDept, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String, strINV_DUE_Date As String, strDISC_Date As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long, strHR As String
Dim strMONTH As String, strDAY As String, strSEC As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strDISC_PCT As String, strDISCYN As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
strFile = "APEXT" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblAPTrans ORDER BY INVOICE_NO"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
strLastInvNo = ""
Do Until oRSSS.EOF
strINVNO = oRSSS!invoice_no
strHeadID = "H"
strCUSTNo = oRSSS!Vendor_no
If Field2Str(oRSSS!Terms_Code) = "04" Then
strDISC_PCT = Field2Str2(oRSSS!DISCOUNT_AMT)
' strDISC_PCT = "2"
strDISCYN = "0"
Else
strDISC_PCT = "0"
strDISCYN = "0"
End If
strTType = "1"
strPONUM = oRSSS!PO_NUMBER
strINVDATE = oRSSS!invoice_date
strShipDate = oRSSS!invoice_date
strINV_DUE_Date = oRSSS!inv_due_date
strDISC_Date = oRSSS!disc_due_date
strUDF1 = oRSSS!job_number
strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strINVNO & vbTab & vbTab & vbTab & strPONUM & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
strHEADER = strHEADER & "0" & vbTab & "0" & vbTab & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINVDATE & vbTab & strDISCYN & vbTab
' strHEADER = strHEADER & "0" & vbTab & "0" & vbTab & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
strHEADER = strHEADER & strDISC_PCT & vbTab & "7" & vbTab & "10150" & vbTab & "0" ' & vbTab & vbTab & vbTab & vbTab & vbTab
TStream.WriteLine (strHEADER)
'Detail:
strDetID = "D"
strLType = "1"
strTXABLE = "1"
strPRICE = oRSSS!INVOICE_AMT
strDETAIL = strDetID & vbTab & strLType & vbTab & "MATERIALS" & vbTab & "50050" & vbTab & vbTab & strDISCYN & vbTab & strDISC_PCT
strDETAIL = strDETAIL & vbTab & vbTab & strUDF1 & vbTab & strINVDATE & vbTab & "1" & vbTab & strPRICE ' & vbTab & vbTab & strTXABLE
TStream.WriteLine (strDETAIL)
oRSSS.Update
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Accounts Payable - Enter Bills and "
strMSG = strMSG & vbCrLf & "GENERATE BILLS using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
End Sub
Private Sub CMSSWTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strPONUM, strDept, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long
Dim strMONTH As String, strDAY As String, strSEC As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strHR As String
Dim strCODEDESC As String, strSHIPINFO As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
If strHR > 12 Then
strHR = Field2Str2(strHR) - 12
strHR = Format(strHR, "00")
End If
strFile = "OE" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblSWARTrans ORDER BY INVOICE_NO" ', DETNUM"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".SWI018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' strEXT = "G:\CMSTrans\" & strFile & ".SWI018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
strLastInvNo = ""
Do Until oRSSS.EOF
strINVNO = oRSSS!invoice_no
' If strLastInvNo = strINVNO Then
' GoTo Detail
' End If
strHeadID = "H"
strCUSTNo = oRSSS!customer_no
strSHIPADD = oRSSS!shipping
strCHG = "3"
strTType = "0"
strLastInvNo = strINVNO
strPONUM = Field2Str(oRSSS!comment)
' strPONUM = ""
strDept = "Dept01"
strTaxCode = "NT"
' strTaxCode = oRSSS!taxcode
strINVDATE = oRSSS!invoice_date
strShipDate = oRSSS!invoice_date
strUDF1 = oRSSS!job_number
strUDF2 = oRSSS!UDF2
strCODEDESC = Field2Str(oRSSS!CodeDesc)
strSHIPINFO = Left(strCODEDESC, 34)
'*****need to remove strPONUM from position after the strINVNO field
' strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strSHIPINFO & vbTab & strSHIPINFO & vbTab & strUDF2 & vbTab & vbTab & vbTab & vbTab & vbTab
strHEADER = strHeadID & vbTab & strCUSTNo & vbTab & strSHIPINFO & vbTab & strSHIPINFO & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
strHEADER = strHEADER & strCHG & vbTab & strTType & vbTab & strINVNO & vbTab & vbTab & vbTab & strDept & vbTab
strHEADER = strHEADER & vbTab & strTaxCode & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
strHEADER = strHEADER & vbTab & strINVDATE & vbTab & strINVDATE & vbTab & strShipDate & vbTab & strUDF1 & vbTab & strUDF2
TStream.WriteLine (strHEADER)
Detail:
strDetID = "D"
strLType = "1"
strSTOCK = oRSSS!sales_code
strDESC = oRSSS!Description
strTXABLE = "1"
strOQty = "1"
strSQty = "1"
' strOQty = oRSSS!Quantity
' strSQty = oRSSS!Quantity
strPRICE = oRSSS!price
strDETAIL = strDetID & vbTab & strLType & vbTab & strSTOCK & vbTab & vbTab & strDESC ' & vbTab & Format(dblRU2D1, "00000000.0000")
strDETAIL = strDETAIL & vbTab & vbTab & vbTab & strTaxCode & vbTab & vbTab & strTXABLE
strDETAIL = strDETAIL & vbTab & vbTab & vbTab & vbTab & strOQty & vbTab & strSQty & vbTab & vbTab & strPRICE 'vbTab & vbTab & vbTab & vbTab
TStream.WriteLine (strDETAIL)
oRSSS.Update
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Sales Module then "
strMSG = strMSG & vbCrLf & "Order Entry - GENERATE ORDERS Using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
End Sub
Reference in New Issue View Git Blame Copy Permalink