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