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