VERSION 5.00 Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX" Begin VB.Form frmPlans BorderStyle = 1 'Fixed Single Caption = "Plans" ClientHeight = 8625 ClientLeft = 45 ClientTop = 330 ClientWidth = 11910 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 8625 ScaleWidth = 11910 StartUpPosition = 3 'Windows Default Visible = 0 'False Begin VB.CheckBox chkHLNotes Alignment = 1 'Right Justify Caption = "Hi-Lite Notes" Height = 195 Left = 10410 TabIndex = 145 Top = 1245 Width = 1380 End Begin VB.CommandButton cmdPictures Caption = "Elevation Pictures" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 7200 TabIndex = 142 Top = 1200 Visible = 0 'False Width = 1335 End Begin VB.CheckBox chkPaint Alignment = 1 'Right Justify Caption = "Paint" Height = 285 Left = 6450 TabIndex = 141 Top = 870 Width = 690 End Begin VB.TextBox txtPaintSQFT Alignment = 1 'Right Justify Height = 315 Left = 5520 TabIndex = 140 Top = 990 Width = 855 End Begin VB.CheckBox chk2STORY Alignment = 1 'Right Justify Caption = "2 Story Plan" Height = 255 Left = 7320 TabIndex = 16 Top = 900 Width = 1215 End Begin VB.TextBox txt108 Height = 315 Left = 3780 TabIndex = 20 Top = 1740 Width = 675 End Begin VB.TextBox txt68 Height = 315 Left = 2520 TabIndex = 19 Top = 1740 Width = 675 End Begin VB.CheckBox chkVerified Alignment = 1 'Right Justify Caption = "Verified Plan:" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 765 TabIndex = 124 Top = 225 Width = 1500 End Begin VB.CheckBox chkOpen Alignment = 1 'Right Justify Caption = "Remove Openings:" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Left = 300 TabIndex = 123 Top = 30 Width = 1965 End Begin VB.CheckBox chkUpdate Alignment = 1 'Right Justify Caption = "Update:" Height = 195 Left = 2880 TabIndex = 120 Top = 225 Width = 975 End Begin VB.TextBox txtWireAdj Alignment = 1 'Right Justify Height = 315 Left = 8340 MaxLength = 4 TabIndex = 13 Top = -30 Width = 855 End Begin VB.CommandButton cmdUpPlan Caption = "Update From Takeoff" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8640 TabIndex = 111 Top = 1200 Width = 1335 End Begin VB.TextBox txtStone Alignment = 1 'Right Justify Height = 315 Left = 5520 TabIndex = 10 Top = -45 Width = 855 End Begin VB.CheckBox chkStone Alignment = 1 'Right Justify Caption = "Stone Veneer" Height = 195 Left = 2415 TabIndex = 9 Top = 45 Width = 1455 End Begin VB.CommandButton cmdUpdate Caption = "Update Inventory #'s" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8640 TabIndex = 107 TabStop = 0 'False Top = 3120 Visible = 0 'False Width = 1335 End Begin VB.TextBox txtOld Height = 315 Left = 555 TabIndex = 104 Top = 855 Visible = 0 'False Width = 855 End Begin VB.TextBox txtNew Height = 315 Left = 2055 TabIndex = 106 Top = 855 Visible = 0 'False Width = 855 End Begin VB.CommandButton cmdExit Caption = "E&xit" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 7200 TabIndex = 102 TabStop = 0 'False Top = 3120 Width = 1335 End Begin VB.CommandButton cmdCProj Caption = "Copy Plan to New Project" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8640 TabIndex = 101 TabStop = 0 'False Top = 2640 Width = 1335 End Begin VB.CommandButton cmdCopyAll Caption = "Copy All TakeOffs" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8640 TabIndex = 100 TabStop = 0 'False Top = 1680 Width = 1335 End Begin VB.ListBox lstProject Height = 1230 Left = 10260 Sorted = -1 'True TabIndex = 99 TabStop = 0 'False Top = 1920 Visible = 0 'False Width = 1395 End Begin VB.ListBox lstTake Height = 1620 Left = 10260 Sorted = -1 'True TabIndex = 96 TabStop = 0 'False Top = 1920 Visible = 0 'False Width = 1395 End Begin VB.CommandButton cmdCopyTakeoff Caption = "Copy 1 TakeOff" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8640 TabIndex = 95 TabStop = 0 'False Top = 2145 Width = 1335 End Begin VB.TextBox txtNewModel BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2280 MaxLength = 8 TabIndex = 8 Top = 1080 Visible = 0 'False Width = 1155 End Begin VB.CommandButton cmdDelPlan Caption = "&Delete Plan" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 7200 TabIndex = 92 TabStop = 0 'False Top = 2640 Width = 1335 End Begin VB.CommandButton cmdSavePlan Caption = "&Save Plan" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 7200 TabIndex = 23 Top = 2160 Width = 1335 End Begin VB.CommandButton cmdNewPlan Caption = "New &Plan" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 7200 TabIndex = 91 TabStop = 0 'False Top = 1680 Width = 1335 End Begin VB.TextBox txtProject Enabled = 0 'False Height = 315 Left = 975 TabIndex = 80 TabStop = 0 'False Top = 510 Width = 3075 End Begin VB.TextBox txtPLAdj Alignment = 1 'Right Justify Height = 315 Left = 10800 MaxLength = 4 TabIndex = 18 Top = 300 Width = 855 End Begin VB.TextBox txtPFAdj Alignment = 1 'Right Justify Height = 315 Left = 10800 MaxLength = 4 TabIndex = 17 Top = -15 Width = 855 End Begin TabDlg.SSTab tabPlans Height = 4815 Left = 210 TabIndex = 25 Top = 3675 Width = 11535 _ExtentX = 20346 _ExtentY = 8493 _Version = 393216 Tabs = 2 Tab = 1 TabsPerRow = 2 TabHeight = 520 TabCaption(0) = "&Materials" TabPicture(0) = "frmPlans.frx":0000 Tab(0).ControlEnabled= 0 'False Tab(0).Control(0)= "cmdFindMat" Tab(0).Control(1)= "lstMInventory" Tab(0).Control(1).Enabled= 0 'False Tab(0).Control(2)= "cmdInventory" Tab(0).Control(2).Enabled= 0 'False Tab(0).Control(3)= "cmdDelMat" Tab(0).Control(3).Enabled= 0 'False Tab(0).Control(4)= "cmdSaveMat" Tab(0).Control(5)= "cmdAddMat" Tab(0).Control(5).Enabled= 0 'False Tab(0).Control(6)= "cboPMMetal" Tab(0).Control(7)= "cboPMType" Tab(0).Control(8)= "cboPMDFlag" Tab(0).Control(9)= "txtPMLength" Tab(0).Control(10)= "txtPMPrice" Tab(0).Control(11)= "txtPMQty" Tab(0).Control(12)= "txtPMDesc" Tab(0).Control(13)= "txtPMInvNo" Tab(0).Control(14)= "lstPMaterial" Tab(0).Control(14).Enabled= 0 'False Tab(0).Control(15)= "lblPMLength" Tab(0).Control(16)= "lblPMMetal" Tab(0).Control(17)= "lblPMType" Tab(0).Control(18)= "lblPMDFLag" Tab(0).Control(19)= "lblPMPrice" Tab(0).Control(20)= "lblPMQty" Tab(0).Control(21)= "lblPMDesc" Tab(0).Control(22)= "lblPMInvNo" Tab(0).ControlCount= 23 TabCaption(1) = "&Options" TabPicture(1) = "frmPlans.frx":001C Tab(1).ControlEnabled= -1 'True Tab(1).Control(0)= "lblOptYdge" Tab(1).Control(0).Enabled= 0 'False Tab(1).Control(1)= "lblOptFin2" Tab(1).Control(1).Enabled= 0 'False Tab(1).Control(2)= "lblOptFAdjYdge" Tab(1).Control(2).Enabled= 0 'False Tab(1).Control(3)= "lblOTexture" Tab(1).Control(3).Enabled= 0 'False Tab(1).Control(4)= "lblOMInvNo" Tab(1).Control(4).Enabled= 0 'False Tab(1).Control(5)= "lblOMDesc" Tab(1).Control(5).Enabled= 0 'False Tab(1).Control(6)= "lblOMQty" Tab(1).Control(6).Enabled= 0 'False Tab(1).Control(7)= "lblOMDflag" Tab(1).Control(7).Enabled= 0 'False Tab(1).Control(8)= "lblOMMType" Tab(1).Control(8).Enabled= 0 'False Tab(1).Control(9)= "lblOMetal" Tab(1).Control(9).Enabled= 0 'False Tab(1).Control(10)= "lblOMLength" Tab(1).Control(10).Enabled= 0 'False Tab(1).Control(11)= "lblBill" Tab(1).Control(11).Enabled= 0 'False Tab(1).Control(12)= "lblElev" Tab(1).Control(12).Enabled= 0 'False Tab(1).Control(13)= "lblOSt_SqFt" Tab(1).Control(13).Enabled= 0 'False Tab(1).Control(14)= "lblO68" Tab(1).Control(14).Enabled= 0 'False Tab(1).Control(15)= "lblO108" Tab(1).Control(15).Enabled= 0 'False Tab(1).Control(16)= "lblOptNum" Tab(1).Control(16).Enabled= 0 'False Tab(1).Control(17)= "lblOEffDate" Tab(1).Control(17).Enabled= 0 'False Tab(1).Control(18)= "lblOptUsed" Tab(1).Control(18).Enabled= 0 'False Tab(1).Control(19)= "lblTOptID" Tab(1).Control(19).Enabled= 0 'False Tab(1).Control(20)= "lstOptions" Tab(1).Control(20).Enabled= 0 'False Tab(1).Control(21)= "txtODesc" Tab(1).Control(21).Enabled= 0 'False Tab(1).Control(22)= "txtOYdge" Tab(1).Control(22).Enabled= 0 'False Tab(1).Control(23)= "txtOFin2" Tab(1).Control(23).Enabled= 0 'False Tab(1).Control(24)= "txtOFAdj" Tab(1).Control(24).Enabled= 0 'False Tab(1).Control(25)= "lstOptMatrl" Tab(1).Control(25).Enabled= 0 'False Tab(1).Control(26)= "cboOTexture" Tab(1).Control(26).Enabled= 0 'False Tab(1).Control(27)= "txtOMDesc" Tab(1).Control(27).Enabled= 0 'False Tab(1).Control(28)= "txtOMInvNo" Tab(1).Control(28).Enabled= 0 'False Tab(1).Control(29)= "txtOMQty" Tab(1).Control(29).Enabled= 0 'False Tab(1).Control(30)= "txtOMLength" Tab(1).Control(30).Enabled= 0 'False Tab(1).Control(31)= "cboOMDflag" Tab(1).Control(31).Enabled= 0 'False Tab(1).Control(32)= "cboOMType" Tab(1).Control(32).Enabled= 0 'False Tab(1).Control(33)= "cboOMMetal" Tab(1).Control(33).Enabled= 0 'False Tab(1).Control(34)= "cmdAddOpt" Tab(1).Control(34).Enabled= 0 'False Tab(1).Control(35)= "cmdDelOpt" Tab(1).Control(35).Enabled= 0 'False Tab(1).Control(36)= "cmdSaveOpt" Tab(1).Control(36).Enabled= 0 'False Tab(1).Control(37)= "cmdAddOptMat" Tab(1).Control(37).Enabled= 0 'False Tab(1).Control(38)= "cmdDelOptMat" Tab(1).Control(38).Enabled= 0 'False Tab(1).Control(39)= "cmdSaveOptMat" Tab(1).Control(39).Enabled= 0 'False Tab(1).Control(40)= "cmdInvList" Tab(1).Control(40).Enabled= 0 'False Tab(1).Control(41)= "lstInventory" Tab(1).Control(41).Enabled= 0 'False Tab(1).Control(42)= "cmdCopyOpt" Tab(1).Control(42).Enabled= 0 'False Tab(1).Control(43)= "cmdFindOptMat" Tab(1).Control(43).Enabled= 0 'False Tab(1).Control(44)= "txtBillAmt" Tab(1).Control(44).Enabled= 0 'False Tab(1).Control(45)= "txtNote" Tab(1).Control(45).Enabled= 0 'False Tab(1).Control(46)= "txtElev" Tab(1).Control(46).Enabled= 0 'False Tab(1).Control(47)= "chkOStone" Tab(1).Control(47).Enabled= 0 'False Tab(1).Control(48)= "txtOSt_SqFt" Tab(1).Control(48).Enabled= 0 'False Tab(1).Control(49)= "txtO68" Tab(1).Control(49).Enabled= 0 'False Tab(1).Control(50)= "txtO108" Tab(1).Control(50).Enabled= 0 'False Tab(1).Control(51)= "chkInv" Tab(1).Control(51).Enabled= 0 'False Tab(1).ControlCount= 52 Begin VB.CheckBox chkInv Caption = "No Invoice" Height = 315 Left = 10260 TabIndex = 132 Top = 480 Width = 1140 End Begin VB.TextBox txtO108 Height = 315 Left = 9540 TabIndex = 131 Top = 480 Width = 705 End Begin VB.TextBox txtO68 Height = 315 Left = 7800 TabIndex = 130 Top = 480 Width = 705 End Begin VB.TextBox txtOSt_SqFt Alignment = 1 'Right Justify Height = 315 Left = 10290 TabIndex = 38 Top = 2310 Width = 855 End Begin VB.CheckBox chkOStone Alignment = 1 'Right Justify Caption = "Stone Veneer Option:" Height = 285 Left = 9315 TabIndex = 37 Top = 1950 Width = 1830 End Begin VB.TextBox txtElev Height = 315 Left = 9180 MaxLength = 15 TabIndex = 36 Top = 1590 Width = 1935 End Begin VB.TextBox txtNote Height = 915 Left = 240 TabIndex = 40 Top = 2640 Width = 5475 End Begin VB.TextBox txtBillAmt Alignment = 1 'Right Justify Height = 315 Left = 7800 MaxLength = 6 TabIndex = 34 Top = 1065 Visible = 0 'False Width = 705 End Begin VB.CommandButton cmdFindMat Height = 435 Left = -65250 Picture = "frmPlans.frx":0038 Style = 1 'Graphical TabIndex = 69 Top = 375 Width = 495 End Begin VB.CommandButton cmdFindOptMat Height = 435 Left = 9585 Picture = "frmPlans.frx":047A Style = 1 'Graphical TabIndex = 51 Top = 3015 Width = 495 End Begin VB.CommandButton cmdCopyOpt Caption = "Copy Option" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 4920 TabIndex = 93 TabStop = 0 'False Top = 1440 Width = 1335 End Begin VB.ListBox lstMInventory Height = 3375 Left = -66360 TabIndex = 90 TabStop = 0 'False Top = 1200 Visible = 0 'False Width = 2775 End Begin VB.CommandButton cmdInventory Caption = "Inventory List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = -67800 TabIndex = 89 TabStop = 0 'False Top = 4020 Visible = 0 'False Width = 1335 End Begin VB.CommandButton cmdDelMat Caption = "Delete Material" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = -67800 TabIndex = 88 TabStop = 0 'False Top = 3480 Width = 1335 End Begin VB.CommandButton cmdSaveMat Caption = "Save Material" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = -69240 TabIndex = 77 Top = 4020 Width = 1335 End Begin VB.CommandButton cmdAddMat Caption = "Add Material" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = -69240 TabIndex = 87 TabStop = 0 'False Top = 3480 Width = 1335 End Begin VB.ListBox lstInventory Height = 1815 Left = 240 TabIndex = 86 TabStop = 0 'False Top = 600 Visible = 0 'False Width = 3195 End Begin VB.CommandButton cmdInvList Caption = "Inventory List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 7680 TabIndex = 85 TabStop = 0 'False Top = 2040 Visible = 0 'False Width = 1335 End Begin VB.CommandButton cmdSaveOptMat Caption = "Save Option Material" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6300 TabIndex = 58 Top = 2040 Width = 1335 End Begin VB.CommandButton cmdDelOptMat Caption = "Delete Option Material" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 7680 TabIndex = 84 TabStop = 0 'False Top = 1440 Width = 1335 End Begin VB.CommandButton cmdAddOptMat Caption = "Add Option Material" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6300 TabIndex = 83 TabStop = 0 'False Top = 1440 Width = 1335 End Begin VB.CommandButton cmdSaveOpt Caption = "Save Option" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3540 TabIndex = 39 Top = 2025 Width = 1335 End Begin VB.CommandButton cmdDelOpt Caption = "Delete Option" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 4920 TabIndex = 82 TabStop = 0 'False Top = 2025 Width = 1335 End Begin VB.CommandButton cmdAddOpt Caption = "Add Option" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3540 TabIndex = 81 TabStop = 0 'False Top = 1440 Width = 1335 End Begin VB.ComboBox cboPMMetal Height = 315 ItemData = "frmPlans.frx":08BC Left = -67920 List = "frmPlans.frx":08C6 Style = 2 'Dropdown List TabIndex = 75 Top = 2640 Width = 1155 End Begin VB.ComboBox cboPMType Height = 315 ItemData = "frmPlans.frx":08D7 Left = -67920 List = "frmPlans.frx":08D9 Style = 2 'Dropdown List TabIndex = 74 Top = 2280 Width = 1155 End Begin VB.ComboBox cboPMDFlag Height = 315 ItemData = "frmPlans.frx":08DB Left = -67920 List = "frmPlans.frx":08E5 Style = 2 'Dropdown List TabIndex = 73 Top = 1920 Width = 1155 End Begin VB.TextBox txtPMLength Alignment = 1 'Right Justify Height = 315 Left = -67920 MaxLength = 2 TabIndex = 76 Top = 3000 Width = 915 End Begin VB.TextBox txtPMPrice Alignment = 1 'Right Justify Height = 315 Left = -67920 MaxLength = 6 TabIndex = 72 Top = 1560 Width = 915 End Begin VB.TextBox txtPMQty Alignment = 1 'Right Justify Height = 315 Left = -67920 MaxLength = 4 TabIndex = 71 Top = 1200 Width = 915 End Begin VB.TextBox txtPMDesc Height = 315 Left = -67920 MaxLength = 50 TabIndex = 70 Top = 840 Width = 4275 End Begin VB.TextBox txtPMInvNo Height = 315 Left = -67920 MaxLength = 18 TabIndex = 68 Top = 435 Width = 2625 End Begin VB.ListBox lstPMaterial Height = 4155 Left = -74820 TabIndex = 59 TabStop = 0 'False Top = 480 Width = 5535 End Begin VB.ComboBox cboOMMetal Height = 315 ItemData = "frmPlans.frx":08F9 Left = 9780 List = "frmPlans.frx":0903 Style = 2 'Dropdown List TabIndex = 56 Top = 3975 Width = 1275 End Begin VB.ComboBox cboOMType Height = 315 ItemData = "frmPlans.frx":0914 Left = 9780 List = "frmPlans.frx":0916 Style = 2 'Dropdown List TabIndex = 55 Top = 3525 Width = 1275 End Begin VB.ComboBox cboOMDflag Height = 315 ItemData = "frmPlans.frx":0918 Left = 6900 List = "frmPlans.frx":0922 Style = 2 'Dropdown List TabIndex = 54 Top = 4020 Width = 1155 End Begin VB.TextBox txtOMLength Height = 315 Left = 9780 MaxLength = 2 TabIndex = 57 Top = 4380 Width = 915 End Begin VB.TextBox txtOMQty Alignment = 1 'Right Justify Height = 315 Left = 6900 MaxLength = 4 TabIndex = 53 Top = 3540 Width = 915 End Begin VB.TextBox txtOMInvNo Height = 315 Left = 6900 MaxLength = 18 TabIndex = 50 Top = 3120 Width = 2625 End Begin VB.TextBox txtOMDesc Height = 315 Left = 6900 MaxLength = 50 TabIndex = 52 Top = 2700 Width = 4275 End Begin VB.ComboBox cboOTexture Height = 315 ItemData = "frmPlans.frx":0936 Left = 4680 List = "frmPlans.frx":0938 Style = 2 'Dropdown List TabIndex = 35 Top = 990 Width = 2235 End Begin VB.ListBox lstOptMatrl Height = 1035 Left = 240 TabIndex = 41 TabStop = 0 'False Top = 3600 Width = 5475 End Begin VB.TextBox txtOFAdj Alignment = 1 'Right Justify Height = 315 Left = 10260 MaxLength = 4 TabIndex = 33 Top = 1065 Width = 705 End Begin VB.TextBox txtOFin2 Alignment = 1 'Right Justify Height = 315 Left = 10260 MaxLength = 4 TabIndex = 32 Top = 780 Width = 705 End Begin VB.TextBox txtOYdge Alignment = 1 'Right Justify Height = 315 Left = 7800 MaxLength = 4 TabIndex = 31 Top = 795 Width = 705 End Begin VB.TextBox txtODesc Height = 315 Left = 3525 MaxLength = 30 TabIndex = 30 Top = 615 Width = 3375 End Begin VB.ListBox lstOptions Height = 2010 Left = 240 TabIndex = 26 TabStop = 0 'False Top = 600 Width = 3195 End Begin VB.Label lblTOptID DataMember = "lblTOptID" Height = 210 Left = 240 TabIndex = 138 Top = 390 Width = 3120 End Begin VB.Label lblOptUsed Caption = "OPTION USED" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 210 Left = 5880 TabIndex = 137 Top = 105 Visible = 0 'False Width = 1500 End Begin VB.Label lblOEffDate Alignment = 1 'Right Justify Height = 240 Left = 5475 TabIndex = 136 Top = 360 Width = 1410 End Begin VB.Label lblOptNum Height = 240 Left = 3540 TabIndex = 135 Top = 360 Width = 1890 End Begin VB.Label lblO108 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "10'8"" Frames" Height = 195 Left = 8580 TabIndex = 129 Top = 540 Width = 930 End Begin VB.Label lblO68 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "6'8"" Frames" Height = 195 Left = 6960 TabIndex = 128 Top = 540 Width = 840 End Begin VB.Label lblOSt_SqFt Alignment = 1 'Right Justify Caption = "Stone Veneer Option SqFt:" Height = 435 Left = 9120 TabIndex = 112 Top = 2235 Width = 1170 End Begin VB.Label lblElev AutoSize = -1 'True Caption = "Elevation File Name:" Height = 195 Left = 9240 TabIndex = 110 Top = 1380 Width = 1455 End Begin VB.Label lblBill Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Billing Amt:" Height = 195 Left = 6960 TabIndex = 98 Top = 1125 Visible = 0 'False Width = 765 End Begin VB.Label lblPMLength Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Length:" Height = 195 Left = -69000 TabIndex = 67 Top = 3060 Width = 975 End Begin VB.Label lblPMMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal:" Height = 195 Left = -68460 TabIndex = 66 Top = 2700 Width = 435 End Begin VB.Label lblPMType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Materials Type:" Height = 195 Left = -69105 TabIndex = 65 Top = 2340 Width = 1080 End Begin VB.Label lblPMDFLag Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Delivery Flag:" Height = 195 Left = -68985 TabIndex = 64 Top = 1980 Width = 960 End Begin VB.Label lblPMPrice Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Price:" Height = 195 Left = -68430 TabIndex = 63 Top = 1620 Width = 405 End Begin VB.Label lblPMQty Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Quantity:" Height = 195 Left = -68655 TabIndex = 62 Top = 1260 Width = 630 End Begin VB.Label lblPMDesc Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Description:" Height = 195 Left = -68865 TabIndex = 61 Top = 900 Width = 840 End Begin VB.Label lblPMInvNo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Inventory No:" Height = 195 Left = -68985 TabIndex = 60 Top = 495 Width = 960 End Begin VB.Label lblOMLength Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Length:" Height = 195 Left = 8745 TabIndex = 49 Top = 4440 Width = 975 End Begin VB.Label lblOMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Flag:" Height = 195 Left = 8940 TabIndex = 48 Top = 4050 Width = 780 End Begin VB.Label lblOMMType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Material Type:" Height = 195 Left = 8715 TabIndex = 47 Top = 3600 Width = 1005 End Begin VB.Label lblOMDflag Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Delivery Flag:" Height = 195 Left = 5880 TabIndex = 46 Top = 4080 Width = 960 End Begin VB.Label lblOMQty Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Quantity:" Height = 195 Left = 6210 TabIndex = 45 Top = 3640 Width = 630 End Begin VB.Label lblOMDesc Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Description:" Height = 195 Left = 6000 TabIndex = 44 Top = 2760 Width = 840 End Begin VB.Label lblOMInvNo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Inventory No:" Height = 195 Left = 5880 TabIndex = 43 Top = 3200 Width = 960 End Begin VB.Label lblOTexture Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Option Texture:" Height = 195 Left = 3555 TabIndex = 42 Top = 1065 Width = 1095 End Begin VB.Label lblOptFAdjYdge Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Foam Adj. Yardage:" Height = 195 Left = 8790 TabIndex = 29 Top = 1125 Width = 1395 End Begin VB.Label lblOptFin2 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Finish 2 Yardage:" Height = 195 Left = 8940 TabIndex = 28 Top = 855 Width = 1230 End Begin VB.Label lblOptYdge Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Yardage:" Height = 195 Left = 7065 TabIndex = 27 Top = 855 Width = 645 End End Begin VB.TextBox txtPNotes Height = 855 Left = 2175 MultiLine = -1 'True TabIndex = 22 Top = 2265 Width = 4875 End Begin VB.TextBox txtFin2 Alignment = 1 'Right Justify Height = 315 Left = 8340 MaxLength = 4 TabIndex = 15 Top = 600 Width = 855 End Begin VB.ComboBox cboTexture Height = 315 ItemData = "frmPlans.frx":093A Left = 9915 List = "frmPlans.frx":093C Style = 2 'Dropdown List TabIndex = 21 Top = 645 Width = 1935 End Begin VB.TextBox txt12Foam Alignment = 1 'Right Justify Height = 315 Left = 8340 MaxLength = 4 TabIndex = 14 Top = 300 Width = 855 End Begin VB.TextBox txtCMUYdge Alignment = 1 'Right Justify Height = 315 Left = 5520 MaxLength = 4 TabIndex = 12 Top = 660 Width = 855 End Begin VB.TextBox txtMatYdge Alignment = 1 'Right Justify Height = 315 Left = 5520 MaxLength = 6 TabIndex = 11 Top = 300 Width = 855 End Begin VB.ListBox lstMod_Elv Height = 1620 Left = 600 Sorted = -1 'True TabIndex = 2 TabStop = 0 'False Top = 1395 Width = 1395 End Begin VB.Label lblP_RL AutoSize = -1 'True Caption = "RL OK" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Left = 2325 TabIndex = 144 Top = 225 Visible = 0 'False Width = 570 End Begin VB.Label lblEstID Alignment = 1 'Right Justify AutoSize = -1 'True Caption = " " Height = 195 Left = 180 TabIndex = 143 Top = 225 Width = 525 End Begin VB.Label lblPaint Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Paint SqFt:" Height = 195 Left = 4650 TabIndex = 139 Top = 1050 Width = 780 End Begin VB.Label txtEffDate BorderStyle = 1 'Fixed Single Caption = "12/31/2005" Height = 255 Left = 10800 TabIndex = 134 Top = 960 Width = 975 End Begin VB.Label lblEffDate Alignment = 1 'Right Justify Caption = "Effective Date:" Height = 195 Left = 9420 TabIndex = 133 Top = 1020 Width = 1335 End Begin VB.Label lbl108 AutoSize = -1 'True Caption = "10'8""" Height = 195 Left = 3300 TabIndex = 127 Top = 1800 Width = 375 End Begin VB.Label lbl68 AutoSize = -1 'True Caption = "6'8""" Height = 195 Left = 2220 TabIndex = 126 Top = 1800 Width = 285 End Begin VB.Label lblScaffold AutoSize = -1 'True Caption = "Scaffolding Frames Required" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 2280 TabIndex = 125 Top = 1440 Width = 2460 End Begin VB.Label txtImport Caption = " " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3900 TabIndex = 122 Top = 3375 Width = 3225 End Begin VB.Label lblImport Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Import:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3285 TabIndex = 121 Top = 3375 Width = 600 End Begin VB.Label txtUpdate BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3900 TabIndex = 119 Top = 3165 Width = 1725 End Begin VB.Label lblUpdate Alignment = 2 'Center AutoSize = -1 'True Caption = "Updated:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3060 TabIndex = 118 Top = 3165 Width = 825 End Begin VB.Label txtLSave BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 1125 TabIndex = 117 Top = 3375 Width = 1725 End Begin VB.Label lblLSave Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Last Save:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 135 TabIndex = 116 Top = 3375 Width = 930 End Begin VB.Label txtCreate Caption = " " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 1125 TabIndex = 115 Top = 3150 Width = 1725 End Begin VB.Label lblCreate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Create:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 435 TabIndex = 114 Top = 3165 Width = 630 End Begin VB.Label lblWireAdj Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Wire Adj. Yardage:" Height = 195 Left = 6930 TabIndex = 113 Top = 45 Width = 1335 End Begin VB.Label lblStone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Stone Veneer Sq Ft:" Height = 195 Left = 4005 TabIndex = 109 Top = 75 Width = 1440 End Begin VB.Label lblOld Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "OLD:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 75 TabIndex = 108 Top = 915 Visible = 0 'False Width = 450 End Begin VB.Label lblNew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "NEW:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 1500 TabIndex = 105 Top = 915 Visible = 0 'False Width = 510 End Begin VB.Label lblSQL Caption = $"frmPlans.frx":093E Height = 615 Left = 2205 TabIndex = 103 Top = 1455 Visible = 0 'False Width = 4695 End Begin VB.Label lblTake Alignment = 2 'Center Caption = "Double Click the Desired Elevation" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 10110 TabIndex = 97 Top = 1485 Visible = 0 'False Width = 1695 End Begin VB.Label lblNewModel AutoSize = -1 'True Caption = "New Model/Elevation:" Height = 195 Left = 2175 TabIndex = 94 Top = 885 Visible = 0 'False Width = 1590 End Begin VB.Label lblPLAdj Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Labor Adj. Yardage:" Height = 195 Left = 9285 TabIndex = 79 Top = 360 Width = 1410 End Begin VB.Label lblPFAdj Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Foam Adj. Yardage:" Height = 195 Left = 9300 TabIndex = 78 Top = 60 Width = 1395 End Begin VB.Label lblPNotes Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Notes:" 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 = 2280 TabIndex = 24 Top = 2040 Width = 690 End Begin VB.Label lblFin2 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Finish 2 Yardage:" Height = 195 Left = 7035 TabIndex = 7 Top = 660 Width = 1230 End Begin VB.Label lbl12Foam Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "2X8 Foam Percentage:" Height = 195 Left = 6630 TabIndex = 6 Top = 360 Width = 1635 End Begin VB.Label lblTexture Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Texture:" Height = 195 Left = 9300 TabIndex = 5 Top = 720 Width = 585 End Begin VB.Label lblCMUYdge Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "CMU Yardage:" Height = 195 Left = 4380 TabIndex = 4 Top = 720 Width = 1050 End Begin VB.Label lblMatYdge Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Material Yardage:" Height = 195 Left = 4185 TabIndex = 3 Top = 360 Width = 1245 End Begin VB.Label lblModel_Elv Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Model/Elevation:" 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 = 195 TabIndex = 1 Top = 1140 Width = 1770 End Begin VB.Label lblProj Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Subdivision:" Height = 195 Left = 60 TabIndex = 0 Top = 585 Width = 855 End End Attribute VB_Name = "frmPlans" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRS As Recordset Dim moRSMat As Recordset Dim moRSOpt As Recordset Dim moRSOptMat As Recordset Dim moRSProj As Recordset Dim moRSPB As Recordset Dim moRSPOB As Recordset Dim mboolSHOW As Boolean Dim mboolAdding As Boolean, mboolUPDATE As Boolean Dim mboolCopy As Boolean, mintBOOKMARK As Integer, mintBOOKMARK2 As Integer Dim mstrType As String, mstrMODEL As String, strTYPE As String Dim mintESTID As Long, mintPROJID As Long Dim mintOPTID As Long, mintLOTID As Long Dim mstrSQL As String, mstrProj As String, mstrEffDate As String Dim mstrOriginal As String, mstrINVNO As String Dim mboolOPTUSED As Boolean Const conCOL_NAME As Integer = 0 Const conCOL_WAIT As Integer = 1 Const conCOL_TYPE As Integer = 2 Const conCOL_ID As Integer = 3 Const conGable As Long = 4 Private Sub OpenBilling() Dim strSQL As String, strSql2 As String strSQL = "SELECT * FROM tblplanbill WHERE est_id = 1" Set moRSPB = New Recordset moRSPB.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblPOptBill WHERE OptID = 1" Set moRSPOB = New Recordset moRSPOB.Open strSql2, goConn, adOpenKeyset, adLockOptimistic End Sub Private Sub cboOTexture_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then cboOTexture.ListIndex = -1 End If End Sub Private Sub cboTexture_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then cboTexture.ListIndex = -1 End If End Sub Private Sub chkUpdate_Click() cmdSavePlan.Enabled = True End Sub Private Sub cmdCopyAll_Click() Dim intCOPY As Integer Dim strEffDate As String, intYN As Integer, intYN2 As Integer Dim oRS As Recordset, strSQL As String intCOPY = MsgBox("Are You Sure You Want To Copy All Takeoffs?", vbQuestion + vbYesNo, "COPY TAKEOFF") If intCOPY = vbNo Then Exit Sub End If strEffDate = FindMax2("tblProjDate", "startdate", "Proj_ID", gintPROJID) mstrEffDate = InputBox("Enter the Effective Date for These Plans", "Effective Date", strEffDate) If IsDate(mstrEffDate) Then Else If Len(mstrEffDate) > 0 Then mstrEffDate = Format(mstrEffDate, "00/00/####") If Not IsDate(mstrEffDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If If Not mstrEffDate = strEffDate Then intYN = MsgBox("Your Plan Price Effective Date is not the same as the most current date - Is This What You Want?", vbYesNo, "Check Effective Date") If intYN = vbNo Then strSQL = "Select * FROM tblPROJDATE WHERE Proj_id = " & gintPROJID & " and StartDate = #" & mstrEffDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic On Error Resume Next If oRS.EOF Then MsgBox "The Effective Date You Entered is InValid - Exit & Correct", vbOKOnly, "Invalid Effective Date" Exit Sub End If Else Call AddDate End If End If mboolCopy = True Call CopyAllTake Call ListLoad Call MatLoad Call OptLoad Call OptMatLoad End Sub Private Sub cmdCopyTakeoff_Click() Dim strEffDate As String, intYN As Integer, intYN2 As Integer Dim oRS As Recordset, strSQL As String ' Call SelectTake strEffDate = FindMax2("tblProjDate", "startdate", "Proj_ID", gintPROJID) mstrEffDate = InputBox("Enter the Effective Date for This Imported Plan", "Effective Date", strEffDate) If IsDate(mstrEffDate) Then Else If Len(mstrEffDate) > 0 Then mstrEffDate = Format(mstrEffDate, "00/00/####") If Not IsDate(mstrEffDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If If Not mstrEffDate = strEffDate Then intYN = MsgBox("Your Plan Price Effective Date is not the same as the most current date - Is This What You Want?", vbYesNo, "Check Effective Date") If intYN = vbNo Then strSQL = "Select * FROM tblPROJDATE WHERE Proj_id = " & gintPROJID & " and StartDate = #" & mstrEffDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic On Error Resume Next If oRS.EOF Then MsgBox "The Effective Date You Entered is InValid - Exit & Correct", vbOKOnly, "Invalid Effective Date" Exit Sub End If Else Call AddDate End If End If Call SelectTake If mboolCopy Then Call CopyTake mintBOOKMARK = lstMod_Elv.ListIndex Call ListLoad lstMod_Elv.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Call MatLoad Call OptLoad Call OptMatLoad End If End Sub Private Sub PlanMatLoad() Dim oRS As Recordset, oRSS As Recordset Dim strSQL As String, strSQLL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from tblPlanMat WHERE est_id = " & gintESTID & " ORDER BY Inv_No" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly strSQLL = "SELECT * from tblLotMatrl WHERE lot_id = 1" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockPessimistic Do Until oRS.EOF oRSS.AddNew oRSS!LOT_ID = gintLOTID oRSS!inv_no = Field2Str(oRS!inv_no) oRSS!Desc = Field2Str(oRS!Desc) oRSS!d_flag = Field2Str(oRS!d_flag) oRSS!m_type = Field2Str(oRS!m_type) oRSS!calc_flag = Field2Str(oRS!calc_flag) oRSS!calc_amt = Field2Integer(oRS!calc_amt) oRSS!qty = Field2Str(oRS!qty) oRSS!price = Field2Str(oRS!price) oRSS.Update oRS.MoveNext Loop oRS.Close Exit Sub Error_EH: If Err = "-2147467259" Then Resume Next Else Call ErrorHandler(oRSS.ActiveConnection) Exit Sub End If End Sub Private Sub CopyTake() Dim oRS As Recordset, oRSS As Recordset, oRSMAX As Recordset Dim oRT As Recordset, oRTT As Recordset, intResponse As Integer Dim strOpt As String, strOPTMAT As String, dblOPTID As Double Dim strSQL As String, strSELECT As String, strMAX As String Dim dblMatCost As Double, strPLANELV As String On Error GoTo Error_EH mstrINVNO = "" strSQL = "SELECT * FROM tblTake where proj_id = " & gintPROJID & " and toid = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly strSELECT = "SELECT * FROM tblPlans where proj_id = " & gintPROJID & " and mod_elv = '" & mstrMODEL & "'" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic If oRSS.RecordCount <> 0 Then intResponse = MsgBox("This is a duplicate Plan, Do You Want To Update It?", vbYesNo, "Duplicate Plan") If intResponse = vbNo Then mboolCopy = False Exit Sub Else mboolUPDATE = True If oRS.RecordCount > 0 Then With oRS '' If oRSS!mat_yds > 350 Then ' oRSS!mat_yds = Field2Integer(!lath_yds) - 10 '' oRSS!mat_yds = Field2Integer(!TTL_Yds) '' Else '' oRSS!mat_yds = Field2Integer(!TTL_Yds) '' End If If oRSS!mat_yds > 350 Then ' oRSS!mat_yds = Field2Integer(!lath_yds) - 10 oRSS!mat_yds = Field2Integer(!lath_yds) Else oRSS!mat_yds = Field2Integer(!lath_yds) End If If Field2Integer(!CMUYDS) > 0 Then oRSS!CMUYDS = Int((!CMUYDS / 9) + 0.99) Else oRSS!CMUYDS = 0 End If oRSS!openflg = !openflg oRSS!P_RL = !P_RL oRSS!texture = Field2Str(!finish) oRSS!fin2 = Field2Integer(!fin2) oRSS!foam = 25 oRSS!f_adj = Field2Integer(!f_adj) oRSS!l_adj = Field2Integer(!l_adj) oRSS!st_adj = Field2Integer(!st_adj) oRSS!w_adj = Field2Integer(!w_adj) oRSS!opening = Int(((Field2Integer(!opening) * Field2Integer(!openpr)) / 100) + 0.99) oRSS!openpr = Field2Integer(!openpr) oRSS!notes = Field2Str(!notes) oRSS!stone = !stone oRSS!ST_SQFT = Field2Integer(!ST_SQFT) oRSS!s_lab = Field2Str2(!pl) oRSS!l_lab = Round((Field2Double(!ll) + Field2Double(!mlab)), 2) oRSS!scaf = Field2Str2(!SL_TG) oRSS!CMU = Field2Str2(!cmulab) oRSS!burden = Field2Str2(!BRDN) oRSS!MISC = Field2Str2(!MISC) oRSS!mu = Field2Str2(!mu) oRSS!ohead = Field2Str2(!OHPR) dblMatCost = Field2Str2(!sand) * Field2Str2(!SAND_TONS) dblMatCost = dblMatCost + Field2Double(!MATCOST) + Field2Double(!MATMUPR) + Field2Double(!TPE) oRSS!MATCOST = dblMatCost oRSS!ttlcost = Field2Str2(!BIDC) oRSS!bidprice = Field2Str2(!bidp) oRSS!LUUser = gstrLOGIN oRSS!Update = Date oRSS!toid = !toid oRSS!TO_TTLYDS = Field2Str2(!TTL_Yds) oRSS.Update oRSS!import = Date oRSS!imuser = gstrLOGIN oRSS!Source = "TAKEOFF" oRSS!twostory = !twostory oRSS!Scaf6 = Field2Str2(!Scaf6) oRSS!scaf10 = Field2Str2(!scaf10) End With End If oRS.Close End If Else If oRS.RecordCount > 0 Then With oRS oRSS.AddNew oRSS!Proj_ID = gintPROJID oRSS!Mod_Elv = Field2Str(!pln_elv) strPLANELV = Field2Str(!pln_elv) If oRSS!mat_yds > 350 Then ' oRSS!mat_yds = Field2Integer(!lath_yds) - 10 oRSS!mat_yds = Field2Integer(!lath_yds) Else oRSS!mat_yds = Field2Integer(!lath_yds) End If If Field2Integer(!CMUYDS) > 0 Then oRSS!CMUYDS = Int((!CMUYDS / 9) + 0.99) Else oRSS!CMUYDS = 0 End If oRSS!openflg = !openflg oRSS!P_RL = !P_RL oRSS!texture = Field2Str(!finish) oRSS!fin2 = Field2Integer(!fin2) oRSS!foam = 25 oRSS!f_adj = Field2Integer(!f_adj) oRSS!l_adj = Field2Integer(!l_adj) oRSS!w_adj = Field2Integer(!w_adj) oRSS!st_adj = Field2Integer(!st_adj) oRSS!opening = Int(((Field2Integer(!opening) * Field2Integer(!openpr)) / 100) + 0.99) oRSS!openpr = Field2Integer(!openpr) oRSS!notes = Field2Str(!notes) oRSS!stone = !stone oRSS!ST_SQFT = Field2Integer(!ST_SQFT) oRSS!s_lab = Field2Str2(!pl) oRSS!l_lab = Round((Field2Double(!ll) + Field2Double(!mlab)), 2) oRSS!scaf = Field2Str2(!SL_TG) oRSS!CMU = Field2Str2(!cmulab) oRSS!burden = Field2Str2(!BRDN) oRSS!MISC = Field2Str2(!MISC) oRSS!mu = Field2Str2(!mu) oRSS!ohead = Field2Str2(!OHPR) dblMatCost = Field2Str2(!sand) * Field2Str2(!SAND_TONS) dblMatCost = dblMatCost + Field2Double(!MATCOST) + Field2Double(!MATMUPR) + Field2Double(!TPE) oRSS!MATCOST = dblMatCost oRSS!ttlcost = Field2Str2(!BIDC) oRSS!bidprice = Field2Str2(!bidp) oRSS!createuser = gstrLOGIN oRSS!toid = Field2Str2(!toid) oRSS!TO_TTLYDS = Field2Str2(!TTL_Yds) oRSS.Update oRSS!import = Date oRSS!imuser = gstrLOGIN oRSS!Source = "TAKEOFF" oRSS!twostory = !twostory oRSS!Scaf6 = Field2Str2(!Scaf6) oRSS!scaf10 = Field2Str2(!scaf10) End With End If oRS.Close End If ' oRSS.Close If mboolUPDATE Then mintESTID = gintESTID strSELECT = "DELETE * FROM tblPlanMat WHERE est_id = " & mintESTID goConn.Execute strSELECT Else strSQL = "SELECT Max(Est_id) as MAXestid from tblPlans" Set oRSMAX = New Recordset oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly mintESTID = oRSMAX!maxestid oRSMAX.Close If Not IsDate(mstrEffDate) Then mstrEffDate = txtEffDate End If moRSPB.AddNew moRSPB!est_id = mintESTID moRSPB!Proj_ID = gintPROJID moRSPB!Mod_Elv = strPLANELV moRSPB!effdate = mstrEffDate moRSPB!Create = Date moRSPB!Wrap = moRSProj!Wrap moRSPB!WPctg = moRSProj!WPctg moRSPB.Update End If strSQL = "SELECT * FROM tblTomatrl where NOT TrnsFlag and TOID = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then strSELECT = "SELECT * FROM tblPlanMat WHERE est_id = 1" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF If oRS!inv_no = "5220" Then End If oRSS.AddNew oRSS!Proj_ID = gintPROJID If moRSProj!FHA And Field2Str2(oRS!inv_no) = "1130" Then oRSS!inv_no = "1570" oRSS!Desc = "1 3/8X3 FHA JMB" ' ElseIf oRS!inv = 1570 Then ' Else oRSS!inv_no = Field2Str(oRS!inv_no) oRSS!Desc = Field2Str(oRS!Desc) mstrINVNO = "RSS - " & Field2Str(oRS!inv_no) End If If oRS!inv_no < 1000 Then oRSS!price = oRS!price End If oRSS!qty = Field2Str2(oRS!qty) oRSS!est_id = mintESTID oRSS!d_flag = Field2Str(oRS!d_flag) oRSS!m_type = Field2Str(oRS!m_type) oRSS!calc_flag = Field2Str(oRS!calc_flag) oRSS!calc_amt = Field2Integer(oRS!calc_amt) oRSS.Update oRS.MoveNext Loop oRSS.Close Else MsgBox "No Materials were found to transfer for this Plan" End If oRS.Close strSQL = "SELECT * from tblOption WHERE toid = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If mboolUPDATE Then strOpt = "SELECT * FROM tblPOption where est_id = " & mintESTID Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRSS.EOF strSELECT = "DELETE * FROM tblPOMatrl WHERE optid = " & Field2Long(oRSS!OPTID) goConn.Execute strSELECT oRSS.MoveNext Loop Do Until oRS.EOF strOpt = "SELECT * FROM tblPOption where t_optid = " & Field2Long(oRS!OPTID) Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!T_OptID = Field2Long(oRS!OPTID) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS!invoice = oRS!invoice oRSS!Scaf6 = Field2Str2(oRS!Scaf6) oRSS!scaf10 = Field2Str2(oRS!scaf10) oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) ' strMAX = "SELECT MAX(Optid) as MAXOptid FROM tblPOption" ' Set oRSMAX = New Recordset ' oRSMAX.Open strMAX, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = Field2Long(oRSS!OPTID) ' oRSMAX.Close strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!Proj_ID = gintPROJID oRTT!OPTID = mintOPTID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) mstrINVNO = "RTT - " & Field2Str(oRT!inv_no) End If oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) If oRT!inv_no < 1000 Then oRTT!price = Field2Single(oRT!price) End If oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext Else strOpt = "SELECT * FROM tblPOption where est_id = 7" Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenKeyset, adLockOptimistic oRSS.AddNew oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!T_OptID = Field2Long(oRS!OPTID) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS!invoice = oRS!invoice oRSS!Scaf6 = Field2Str2(oRS!Scaf6) oRSS!scaf10 = Field2Str2(oRS!scaf10) oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) strMAX = "SELECT MAX(Optid) as MAXOptid FROM tblPOption" Set oRSMAX = New Recordset oRSMAX.Open strMAX, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = Field2Long(oRSMAX!maxoptid) oRSMAX.Close strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!Proj_ID = gintPROJID oRTT!OPTID = mintOPTID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) mstrINVNO = "RTT - " & Field2Str(oRT!inv_no) End If oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) If oRT!inv_no < 1000 Then oRTT!price = Field2Single(oRT!price) End If oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext End If Loop Else If oRS.RecordCount > 0 Then strSELECT = "SELECT * FROM tblPOption where est_id = 1" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF oRSS.AddNew oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!T_OptID = Field2Long(oRS!OPTID) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) strMAX = "SELECT MAX(Optid) as MAXOptid FROM tblPOption" Set oRSMAX = New Recordset oRSMAX.Open strMAX, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = Field2Long(oRSMAX!maxoptid) oRSMAX.Close moRSPOB.AddNew moRSPOB!est_id = mintESTID moRSPOB!OPTID = mintOPTID moRSPOB!created = Date moRSPOB!C_USER = gstrLOGIN moRSPOB!Desc = Field2Str(oRS!Desc) moRSPOB!effdate = mstrEffDate moRSPOB.Update strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!Proj_ID = gintPROJID oRTT!OPTID = mintOPTID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) mstrINVNO = "RTT - " & Field2Str(oRT!inv_no) End If oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) If oRT!inv_no < 1000 Then oRTT!price = Field2Single(oRT!price) End If oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext Loop End If End If ' oRS.Close ' oRSS.Close mboolCopy = False mboolAdding = False mboolUPDATE = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module CopyTake - InvNO = " & mstrINVNO Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CopyUpTake() Dim oRS As Recordset, oRSS As Recordset, oRSMAX As Recordset Dim oRT As Recordset, oRTT As Recordset, intResponse As Integer Dim strBILL As String, strPBILL As String, oRB As Recordset, oRPB As Recordset Dim strOpt As String, strOPTMAT As String, dblOPTID As Double Dim strSQL As String, strSELECT As String, strMAX As String Dim dblMatCost As Double On Error GoTo Error_EH If gintTOID = 0 Then Exit Sub Else strSQL = "SELECT * FROM tblTake where proj_id = " & gintPROJID & " and toid = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly strSELECT = "SELECT * FROM tblPlans where proj_id = " & gintPROJID & " and mod_elv = '" & mstrMODEL & "'" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic End If mboolCopy = False mboolAdding = False mboolUPDATE = True If oRS.RecordCount > 0 Then With oRS If oRSS!mat_yds > 350 Then '' oRSS!mat_yds = Field2Integer(!lath_yds) - 10 oRSS!mat_yds = Field2Integer(!lath_yds) Else oRSS!mat_yds = Field2Integer(!lath_yds) End If If Field2Integer(!CMUYDS) > 0 Then oRSS!CMUYDS = Int((!CMUYDS / 9) + 0.99) Else oRSS!CMUYDS = 0 End If oRSS!openflg = !openflg oRSS!P_RL = !P_RL oRSS!texture = Field2Str(!finish) oRSS!fin2 = Field2Integer(!fin2) oRSS!foam = 25 oRSS!f_adj = Field2Integer(!f_adj) oRSS!l_adj = Field2Integer(!l_adj) oRSS!st_adj = Field2Integer(!st_adj) oRSS!w_adj = Field2Integer(!w_adj) oRSS!opening = Int(((Field2Integer(!opening) * Field2Integer(!openpr)) / 100) + 0.99) oRSS!openpr = Field2Integer(!openpr) oRSS!notes = Field2Str(!notes) oRSS!stone = !stone oRSS!ST_SQFT = Field2Integer(!ST_SQFT) oRSS!s_lab = Field2Str2(!pl) oRSS!l_lab = Round((Field2Double(!ll) + Field2Double(!mlab)), 2) oRSS!scaf = Field2Str2(!SL_TG) oRSS!CMU = Field2Str2(!cmulab) oRSS!burden = Field2Str2(!BRDN) oRSS!MISC = Field2Str2(!MISC) oRSS!mu = Field2Str2(!mu) oRSS!ohead = Field2Str2(!OHPR) dblMatCost = Field2Str2(!sand) * Field2Str2(!SAND_TONS) dblMatCost = dblMatCost + Field2Double(!MATCOST) + Field2Double(!MATMUPR) + Field2Double(!TPE) oRSS!MATCOST = dblMatCost oRSS!ttlcost = Field2Str2(!BIDC) oRSS!bidprice = Field2Str2(!bidp) oRSS!LUUser = gstrLOGIN oRSS!Update = Date oRSS!import = Date oRSS!imuser = gstrLOGIN oRSS!Source = "TAKEOFF" oRSS!twostory = !twostory oRSS!Scaf6 = Field2Str2(!Scaf6) oRSS!scaf10 = Field2Str2(!scaf10) oRSS!toid = Field2Str2(!toid) oRSS!TO_TTLYDS = Field2Str2(!TTL_Yds) oRSS.Update End With End If oRS.Close oRSS.Close If mboolUPDATE Then mintESTID = gintESTID strSELECT = "DELETE * FROM tblPlanMat WHERE est_id = " & mintESTID goConn.Execute strSELECT End If strSQL = "SELECT * FROM tblTomatrl where NOT TrnsFlag and TOID = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then strSELECT = "SELECT * FROM tblPlanMat WHERE est_id = 1" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF If oRS!inv_no = "5220" Then End If oRSS.AddNew oRSS!Proj_ID = gintPROJID If moRSProj!FHA And Field2Str2(oRS!inv_no) = "1130" Then oRSS!inv_no = "1570" oRSS!Desc = "1 3/8X3 FHA JMB" ' ElseIf oRS!inv_no = 1570 Then ' Else oRSS!inv_no = Field2Str(oRS!inv_no) oRSS!Desc = Field2Str(oRS!Desc) End If oRSS!qty = Field2Str2(oRS!qty) oRSS!est_id = mintESTID oRSS!d_flag = Field2Str(oRS!d_flag) oRSS!m_type = Field2Str(oRS!m_type) oRSS!calc_flag = Field2Str(oRS!calc_flag) oRSS!calc_amt = Field2Integer(oRS!calc_amt) oRSS.Update oRS.MoveNext Loop oRSS.Close Else MsgBox "No Materials were found to transfer for this Plan" End If oRS.Close strSQL = "SELECT * from tblOption WHERE toid = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If mboolUPDATE Then strOpt = "SELECT * FROM tblPOption where est_id = " & mintESTID Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRSS.EOF strSELECT = "DELETE * FROM tblPOMatrl WHERE optid = " & Field2Long(oRSS!OPTID) goConn.Execute strSELECT oRSS.MoveNext Loop Do Until oRS.EOF strOpt = "SELECT * FROM tblPOption where t_optid = " & Field2Long(oRS!OPTID) Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!T_OptID = Field2Long(oRS!OPTID) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS!Scaf6 = Field2Str2(oRS!Scaf6) oRSS!scaf10 = Field2Str2(oRS!scaf10) oRSS!invoice = oRS!invoice oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) mintOPTID = Field2Long(oRSS!OPTID) strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!Proj_ID = gintPROJID oRTT!OPTID = mintOPTID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) End If oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext Else strOpt = "SELECT * FROM tblPOption where est_id = 7" Set oRSS = New Recordset oRSS.Open strOpt, goConn, adOpenKeyset, adLockOptimistic gstrMODULE = "Inside Add Aoption" oRSS.AddNew oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!T_OptID = Field2Long(oRS!OPTID) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS!Scaf6 = Field2Str2(oRS!Scaf6) oRSS!scaf10 = Field2Str2(oRS!scaf10) oRSS!invoice = oRS!invoice '***** orss!EffDate= oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) strMAX = "SELECT MAX(Optid) as MAXOptid FROM tblPOption" Set oRSMAX = New Recordset oRSMAX.Open strMAX, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = Field2Long(oRSMAX!maxoptid) oRSMAX.Close '****** ' strBILL = "SELECT * FROM tblPlanBill" ' Set oRB = New Recordset ' oRB.Open strSQL, goConn, adOpenDynamic, adLockOptimistic Call AddOptBill ' If Not oRB.EOF Then ' oRB.AddNew ' oRB!est_id = mintESTID ' oRB!proj_id = gintPROJID ' oRB!mod_elv = strPLANELV ' oRB!effdate = mstrEffDate ' oRB!Create = Date ' oRB.Update ' oRB.Close ' End If strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!Proj_ID = gintPROJID oRTT!OPTID = mintOPTID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) End If oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext End If Loop End If mboolCopy = False mboolAdding = False mboolUPDATE = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module CopyUpTake" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CopyAllTake() Dim oRS As Recordset, oRSS As Recordset, oRSMAX As Recordset Dim oRT As Recordset, oRTT As Recordset, oRSTAKE As Recordset Dim strOpt As String, strOPTMAT As String, strTAKE As String Dim strSQL As String, strSELECT As String, strMAX As String Dim strMSG As String, dblOPTID As Double, dblMatCost As Double Dim strMODELV As String On Error GoTo Error_EH '******COPY mstrINVNO = "" Screen.MousePointer = vbHourglass strSQL = "SELECT * FROM tblTake where proj_id = " & gintPROJID ' & " and toid = " & gintTOID Set oRSTAKE = New Recordset oRSTAKE.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRSTAKE.EOF strMODELV = oRSTAKE!pln_elv gintTOID = oRSTAKE!toid strSELECT = "SELECT * FROM tblPlans where proj_id = " & gintPROJID & " and mod_elv = '" & oRSTAKE!pln_elv & "'" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic If oRSS.RecordCount <> 0 Then strMSG = Field2Str(oRSTAKE!pln_elv) & " has already been copied and will be skipped" MsgBox strMSG GoTo Cont_Copy Else If oRSTAKE.RecordCount > 0 Then With oRSTAKE dblMatCost = 0 oRSS.AddNew oRSS!Proj_ID = gintPROJID oRSS!Mod_Elv = Field2Str(!pln_elv) If oRSS!mat_yds > 350 Then oRSS!mat_yds = Field2Integer(!lath_yds) Else oRSS!mat_yds = Field2Integer(!lath_yds) End If If Field2Integer(!CMUYDS) > 0 Then oRSS!CMUYDS = Int((!CMUYDS / 9) + 0.99) Else oRSS!CMUYDS = 0 End If oRSS!openflg = !openflg oRSS!P_RL = !P_RL oRSS!texture = Field2Str(!finish) oRSS!fin2 = Field2Integer(!fin2) oRSS!foam = 25 oRSS!f_adj = Field2Integer(!f_adj) oRSS!l_adj = Field2Integer(!l_adj) oRSS!st_adj = Field2Integer(!st_adj) oRSS!w_adj = Field2Integer(!w_adj) oRSS!opening = Int(((Field2Integer(!opening) * Field2Integer(!openpr)) / 100) + 0.99) oRSS!openpr = Field2Integer(!openpr) oRSS!notes = Field2Str(!notes) oRSS!stone = !stone oRSS!ST_SQFT = Field2Integer(!ST_SQFT) oRSS!s_lab = Field2Str2(!pl) oRSS!l_lab = Round((Field2Double(!ll) + Field2Double(!mlab)), 2) oRSS!scaf = Field2Str2(!SL_TG) oRSS!CMU = Field2Str2(!cmulab) oRSS!burden = Field2Str2(!BRDN) oRSS!MISC = Field2Str2(!MISC) oRSS!mu = Field2Str2(!mu) oRSS!ohead = Field2Str2(!OHPR) dblMatCost = Field2Str2(!sand) * Field2Str2(!SAND_TONS) dblMatCost = dblMatCost + Field2Double(!MATCOST) + Field2Double(!MATMUPR) + Field2Double(!TPE) oRSS!MATCOST = dblMatCost oRSS!ttlcost = Field2Str2(!BIDC) oRSS!bidprice = Field2Str2(!bidp) oRSS!createuser = gstrLOGIN oRSS!import = Date oRSS!imuser = gstrLOGIN oRSS!Source = "TAKEOFF" oRSS!twostory = !twostory oRSS!Scaf6 = Field2Str2(!Scaf6) oRSS!scaf10 = Field2Str2(!scaf10) oRSS!effdate = mstrEffDate oRSS!toid = Field2Str2(!toid) oRSS!TO_TTLYDS = Field2Str2(!TTL_Yds) oRSS.Update End With End If End If oRSS.Close strSQL = "SELECT Max(Est_id) as MAXestid from tblPlans" Set oRSMAX = New Recordset oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly mintESTID = oRSMAX!maxestid oRSMAX.Close moRSPB.AddNew moRSPB!est_id = mintESTID moRSPB!Proj_ID = gintPROJID moRSPB!Mod_Elv = oRSTAKE!pln_elv moRSPB!Create = Date moRSPB!effdate = mstrEffDate moRSPB!Wrap = moRSProj!Wrap moRSPB!WPctg = moRSProj!WPctg moRSPB.Update strSQL = "SELECT * FROM tblTomatrl where NOT TrnsFlag and TOID = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then strSELECT = "SELECT * FROM tblPlanMat WHERE est_id = 1" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF If oRS!inv_no = "5220" Then End If oRSS.AddNew oRSS!Proj_ID = gintPROJID If moRSProj!FHA And Field2Str2(oRS!inv_no) = "1130" Then oRSS!inv_no = "1570" oRSS!Desc = "1 3/8X3 FHA JMB" Else oRSS!inv_no = Field2Str(oRS!inv_no) oRSS!Desc = Field2Str(oRS!Desc) mstrINVNO = "RSS - " & Field2Str(oRS!inv_no) End If ' oRSS!Desc = Field2Str(oRS!Desc) ' oRSS!inv_no = Field2Integer(oRS!inv_no) oRSS!qty = Field2Str(oRS!qty) oRSS!est_id = mintESTID oRSS!d_flag = Field2Str(oRS!d_flag) oRSS!m_type = Field2Str(oRS!m_type) oRSS!calc_flag = Field2Str(oRS!calc_flag) oRSS!calc_amt = Field2Integer(oRS!calc_amt) If oRS!inv_no < 1000 Then oRSS!price = Field2Single(oRS!price) End If oRSS.Update oRS.MoveNext Loop oRSS.Close Else MsgBox "No Materials were found to transfer for this Plan" End If oRS.Close strSQL = "SELECT * from tblOption WHERE toid = " & gintTOID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then strSELECT = "SELECT * FROM tblPOption where est_id = 1" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF oRSS.AddNew oRSS!est_id = mintESTID oRSS!Desc = Field2Str(oRS!Desc) oRSS!Yardage = Field2Integer(oRS!yards) oRSS!f_adj = Field2Integer(oRS!f_adj) oRSS!texture = Field2Str(oRS!texture) oRSS!fin2 = Field2Integer(oRS!fin2) oRSS!notes = Field2Str(oRS!notes) oRSS!ostone = oRS!ostone oRSS!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSS!invoice = oRS!invoice oRSS!Scaf6 = Field2Str2(oRS!Scaf6) oRSS!scaf10 = Field2Str2(oRS!scaf10) oRSS!effdate = mstrEffDate oRSS.Update dblOPTID = Field2Str2(oRS!OPTID) strMAX = "SELECT MAX(Optid) as MAXOptid FROM tblPOption" Set oRSMAX = New Recordset oRSMAX.Open strMAX, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = oRSMAX!maxoptid oRSMAX.Close moRSPOB.AddNew moRSPOB!est_id = mintESTID moRSPOB!OPTID = mintOPTID ' moRSPOB!Create = Date moRSPOB!C_USER = gstrLOGIN moRSPOB!Desc = oRS!Desc moRSPOB!effdate = mstrEffDate moRSPOB.Update strOpt = "SELECT * FROM tblOptMatrl where optid = " & dblOPTID Set oRT = New Recordset oRT.Open strOpt, goConn, adOpenForwardOnly, adLockReadOnly If oRT.RecordCount > 0 Then strOPTMAT = "SELECT * FROM tblPOMatrl where optid = 1" Set oRTT = New Recordset oRTT.Open strOPTMAT, goConn, adOpenKeyset, adLockOptimistic Do Until oRT.EOF oRTT.AddNew oRTT!OPTID = mintOPTID oRTT!Proj_ID = gintPROJID If moRSProj!FHA And Field2Str2(oRT!inv_no) = "1130" Then oRTT!inv_no = "1570" oRTT!Desc = "1 3/8X3 FHA JMB" Else oRTT!inv_no = Field2Str(oRT!inv_no) oRTT!Desc = Field2Str(oRT!Desc) mstrINVNO = "RTT - " & Field2Str(oRT!inv_no) End If ' oRTT!inv_no = Field2Integer(oRT!inv_no) ' oRTT!Desc = Field2Str(oRT!Desc) oRTT!qty = Field2Str(oRT!qty) oRTT!d_flag = Field2Str(oRT!d_flag) oRTT!m_type = Field2Str(oRT!m_type) oRTT!calc_flag = Field2Str(oRT!calc_flag) oRTT!calc_amt = Field2Integer(oRT!calc_amt) If oRT!inv_no < 1000 Then oRTT!price = Field2Single(oRT!price) End If oRTT.Update oRT.MoveNext Loop oRT.Close oRTT.Close End If oRS.MoveNext Loop End If Cont_Copy: oRSTAKE.MoveNext Loop ' oRS.Close ' oRSS.Close mboolCopy = False mboolAdding = False Screen.MousePointer = vbDefault Exit Sub Error_EH: gstrMODULE = "Form Plans - Module CopyAllTake - InvNO = " & mstrINVNO & " - Plan " & strMODELV Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectTake() Dim oRS As Recordset Dim strSQL As String, strMODEL As String On Error GoTo Error_EH mboolCopy = True strMODEL = InputBox("Enter the Elevation to copy from Takeoff", "Copy from Takeoff") mstrMODEL = strMODEL If strMODEL <> "" Then strSQL = "SELECT TOID from tblTake WHERE Pln_elv = '" & strMODEL & "' and proj_id = " & gintPROJID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Else mboolCopy = False Exit Sub End If If oRS.EOF Then mboolCopy = False oRS.Close Call TakeLoad Else gintTOID = Field2Str(oRS!toid) End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module SelectTake" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectUpTake() Dim oRS As Recordset Dim strSQL As String, strMODEL As String On Error GoTo Error_EH mboolCopy = True mstrMODEL = lstMod_Elv.List(lstMod_Elv.ListIndex) ' strSQL = "SELECT TOID from tblTake WHERE Pln_elv = '" & mstrMODEL & "' and proj_id = " & gintPROJID strSQL = "SELECT TOID from tblTake WHERE Pln_elv = '" & mstrMODEL & "' and proj_id = " & gintPROJID & " and not SUPERSEDE" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.EOF Then gintTOID = 0 Else gintTOID = Field2Str(oRS!toid) End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module SelectTake" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdUpdate_Click() Dim strSQL As String, strFIND As String Dim oRS As Recordset If cmdUpdate.Caption = "Process Update" Then cmdUpdate.Caption = "Update Inventory #'s" If Len(txtOld) = 0 Or Len(txtNew) = 0 Then MsgBox "A number must be entered into both the OLD and NEW boxes", vbOKOnly, "ReEnter" lblSQL.Visible = False lblOld.Visible = False lblNew.Visible = False txtOld.Visible = False txtNew.Visible = False txt68.Visible = True txt108.Visible = True lbl68.Visible = True lbl108.Visible = True lblScaffold.Visible = True cmdCopyAll.Enabled = True cmdCopyTakeoff.Enabled = True cmdSavePlan.Enabled = False cmdCProj.Enabled = True cmdNewPlan.Enabled = True cmdDelPlan.Enabled = True Exit Sub End If strFIND = "SELECT * FROM tblInvtry WHERE Inv_No = '" & Field2Str2(txtNew) & "'" Set oRS = New Recordset oRS.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly If oRS.EOF Then MsgBox "You have entered an invalid Inventory Number into the NEW box", vbOKOnly, "REENTER" lblSQL.Visible = False lblOld.Visible = False lblNew.Visible = False txtOld.Visible = False txtNew.Visible = False txt68.Visible = True txt108.Visible = True lbl68.Visible = True lbl108.Visible = True lblScaffold.Visible = True cmdCopyAll.Enabled = True cmdCopyTakeoff.Enabled = True cmdCProj.Enabled = True cmdNewPlan.Enabled = True cmdDelPlan.Enabled = True cmdSavePlan.Enabled = False Exit Sub Else Screen.MousePointer = vbHourglass strSQL = "UPDATE tblPlanMat SET [inv_no] = " & Field2Str2(oRS!inv_no) strSQL = strSQL & ", [desc] = '" & Field2Str2(oRS!Desc) strSQL = strSQL & "', [d_flag] = '" & Field2Str2(oRS!d_flag) strSQL = strSQL & "', [M_type] = '" & Field2Str2(oRS!m_type) strSQL = strSQL & "', [calc_flag] = '" & Field2Str(oRS!calc_flag) strSQL = strSQL & "', [calc_amt] = " & Field2Str2(oRS!calc_amt) strSQL = strSQL & ", [price] = " & Field2Str2(oRS!price) strSQL = strSQL & " WHERE proj_id = " & gintPROJID & " and inv_no = '" & Field2Str2(txtOld) & "'" goConn.Execute strSQL strSQL = "UPDATE tblPOMatrl SET [inv_no] = '" & Field2Str2(oRS!inv_no) & "'" ' strSQL = "UPDATE tblPOMatrl SET " '[inv_no] = " & Field2Str2(oRS!inv_no) strSQL = strSQL & ", [desc] = '" & Field2Str2(oRS!Desc) strSQL = strSQL & "', [d_flag] = '" & Field2Str2(oRS!d_flag) strSQL = strSQL & "', [M_type] = '" & Field2Str2(oRS!m_type) strSQL = strSQL & "', [calc_flag] = '" & Field2Str(oRS!calc_flag) strSQL = strSQL & "', [calc_amt] = " & Field2Str2(oRS!calc_amt) ' strSQL = strSQL & ", [price] = " & Field2Str2(oRS!price) strSQL = strSQL & " WHERE proj_id = " & gintPROJID & " and inv_no = '" & Field2Str2(txtOld) & "'" goConn.Execute strSQL lblSQL.Visible = False lblOld.Visible = False lblNew.Visible = False txtOld.Visible = False txtNew.Visible = False txt68.Visible = True txt108.Visible = True lbl68.Visible = True lbl108.Visible = True lblScaffold.Visible = True cmdCopyAll.Enabled = True cmdCopyTakeoff.Enabled = True cmdSavePlan.Enabled = False cmdCProj.Enabled = True cmdNewPlan.Enabled = True cmdDelPlan.Enabled = True Screen.MousePointer = vbDefault End If Else txtOld = vbNullString txtNew = vbNullString lblSQL.Visible = True lblOld.Visible = True lblNew.Visible = True txtOld.Visible = True txtNew.Visible = True txt68.Visible = False txt108.Visible = False lbl68.Visible = False lbl108.Visible = False lblScaffold.Visible = False cmdUpdate.Caption = "Process Update" txtOld.SetFocus cmdCopyAll.Enabled = False cmdCopyTakeoff.Enabled = False cmdCProj.Enabled = False cmdSavePlan.Enabled = False cmdNewPlan.Enabled = False cmdDelPlan.Enabled = False End If End Sub Private Sub cmdUpPlan_Click() Call SelectUpTake If mboolCopy Then Call CopyUpTake mintBOOKMARK = lstMod_Elv.ListIndex Call ListLoad lstMod_Elv.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Call MatLoad Call OptLoad Call OptMatLoad End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub cboOMMetal_Change() If cboOMMetal.Text = "None" Then txtOMLength.Text = 0 End If End Sub Private Sub cboOMMetal_Click() If cboOMMetal.Text = "None" Then txtOMLength.Text = 0 End If End Sub Private Sub cmdAddMat_Click() Call ToggleMatButtons cmdInventory.Visible = True mboolAdding = True Call MatClear txtPMInvNo.SetFocus cmdFindMat.Visible = True lstPMaterial.Enabled = False End Sub Private Sub cmdAddOpt_Click() cmdAddOptMat.Enabled = False cmdSaveOpt.Enabled = True cmdDelOpt.Enabled = False cmdDelOptMat.Enabled = False cmdAddOpt.Enabled = False mboolAdding = True lstOptions.Enabled = False lstOptMatrl.Enabled = False Call OptClear txtODesc.SetFocus End Sub Private Sub cmdAddOptMat_Click() cmdInvList.Visible = True cmdAddOpt.Enabled = False cmdAddOptMat.Enabled = False cmdDelOptMat.Enabled = False cmdSaveOptMat.Enabled = True lstOptMatrl.Enabled = False lstOptions.Enabled = False mboolAdding = True Call OptMatClear txtOMInvNo.SetFocus cmdFindOptMat.Visible = True End Sub Private Sub cmdCopyPlan_Click() Dim oRS2 As Recordset Dim strSQL As String On Error GoTo Error_EH Set oRS2 = New Recordset Set oRS2 = moRS.Clone oRS2.AddNew oRS2!Proj_ID = gintPROJID oRS2!Mod_Elv = "test2" oRS2!mat_yds = Field2Integer(moRS!mat_yds) oRS2.Update Exit Sub Error_EH: gstrMODULE = "Form Plans - Module cmdCopyPlan_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub TextChanged() If Not mboolSHOW Then If Not cmdSavePlan.Enabled Then Call ToggleButtons End If End If End Sub Private Sub cmdCopyOpt_Click() Dim strMODEL As String, strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strMODEL = InputBox("Enter the Model/Elevation to Copy this Option", "Model/Elevation") strMODEL = UCase(strMODEL) If strMODEL <> "" Then strSQL = "SELECT Est_id, proj_id, mod_elv from tblPlans WHERE Proj_id = " & gintPROJID & " and mod_elv = '" & strMODEL & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then mintESTID = oRS!est_id mboolCopy = True Call cmdSaveOpt_Click Else MsgBox "The Model/Elevation you entered was not found. Verify the Model/Elevation and try again!", vbOKOnly, "Invalid Model/Elevation" cmdAddOpt.Enabled = True cmdSaveOpt.Enabled = False cmdDelOpt.Enabled = False cmdCopyOpt.Enabled = False cmdAddOptMat.Enabled = True Exit Sub End If Else Exit Sub End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module cmdCopyOpt_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdDelMat_Click() Dim strYN As String strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If mintBOOKMARK = lstPMaterial.ListIndex moRSMat.Delete Call MatLoad cmdSaveMat.Enabled = False cmdDelMat.Enabled = False cmdAddMat.Enabled = True If lstPMaterial.ListCount > 0 Then If lstPMaterial.ListCount > mintBOOKMARK Then lstPMaterial.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Else lstPMaterial.ListIndex = mintBOOKMARK - 1 End If End If End Sub Private Sub cmdDelOpt_Click() Dim strSQL As String Dim strYN As String Dim oRS As Recordset strYN = MsgBox("Are You Sure You Want To Delete this Option?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If strSQL = "SELECT * FROM tblLOption WHERE opt_id = " & gintOPTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then MsgBox "This Option Has Been Used With A Lot - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE" Exit Sub End If mintBOOKMARK = lstOptions.ListIndex cmdDelOpt.Enabled = False cmdAddOpt.Enabled = True cmdSaveOpt.Enabled = False cmdCopyOpt.Enabled = False cmdAddOptMat.Enabled = True strSQL = "DELETE * FROM tblPOMatrl where OPTid = " & gintOPTID goConn.Execute strSQL strSQL = "DELETE * FROM tblPOptBill where OPTid = " & gintOPTID goConn.Execute strSQL strSQL = "DELETE * FROM tblPOption WHERE Est_ID = " & gintESTID & " and Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex) goConn.Execute strSQL Call OptClear Call OptLoad If lstOptions.ListCount > 0 Then If lstOptions.ListCount > mintBOOKMARK Then lstOptions.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Else lstOptions.ListIndex = mintBOOKMARK - 1 End If End If End Sub Private Sub cmdDelOptMat_Click() Dim strYN As String strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If mintBOOKMARK = lstOptions.ListIndex cmdAddOpt.Enabled = True cmdAddOptMat.Enabled = True cmdSaveOptMat.Enabled = False cmdDelOptMat.Enabled = False moRSOptMat.Delete Call OptLoad If lstOptions.ListCount > 0 Then If lstOptions.ListCount > mintBOOKMARK Then lstOptions.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Else lstOptions.ListIndex = mintBOOKMARK - 1 End If End If End Sub Private Sub cmdDelPlan_Click() Dim strSQL As String, strSELECT As String, strYN As String Dim oRS As Recordset On Error GoTo Error_EH strYN = MsgBox("Are you sure you want to delete this plan?", vbCritical + vbYesNo, "Delete??") If strYN = vbNo Then Exit Sub End If strSQL = "SELECT * FROM tblLotInfo WHERE Est_id = " & gintESTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then MsgBox "This Plan Has Been Used In Orders - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE" Exit Sub End If mintBOOKMARK = lstMod_Elv.ListIndex cmdDelPlan.Enabled = True cmdNewPlan.Enabled = True strSELECT = "SELECT * FROM tblPOption WHERE Est_id = " & gintESTID Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then Do Until oRS.EOF strSQL = "DELETE * FROM tblPOMatrl where OPTid = " & oRS!OPTID goConn.Execute strSQL oRS.MoveNext Loop End If strSQL = "DELETE * FROM tblPlanBill WHERE Est_ID = " & gintESTID goConn.Execute strSQL strSQL = "DELETE * FROM tblPOptBill WHERE Est_ID = " & gintESTID goConn.Execute strSQL strSQL = "DELETE * FROM tblPOption WHERE Est_ID = " & gintESTID '& " and Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex) goConn.Execute strSQL strSQL = "DELETE * FROM tblPlanMat WHERE Est_id = " & gintESTID goConn.Execute strSQL moRS.Delete Call ListLoad If lstMod_Elv.ListCount > 0 Then If lstMod_Elv.ListCount > mintBOOKMARK Then lstMod_Elv.ListIndex = mintBOOKMARK mintBOOKMARK = 0 Else lstMod_Elv.ListIndex = mintBOOKMARK - 1 End If End If If gstrFLAG = "D" Then Unload Me Exit Sub End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module cmdDelPlan_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown Dim oRS As Recordset, strSQL As String, strYN 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 = vbKeyO And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Display key combinations. If CtrlDown Then ' Call UpStart Call AddOptBill3 End If End If If Not cmdSavePlan.Enabled Then Call DataHasChanged End If End Sub Private Sub UpStart() Dim strEffDate As String Dim strSQL As String, oRS As Recordset strEffDate = InputBox("Enter the New Effective Date for This Plan", "New Effective Date", txtEffDate) If IsDate(strEffDate) Then txtEffDate = strEffDate End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim intResponse As Integer, strMSG As String On Error GoTo Error_EH If cmdSavePlan.Enabled Then strMSG = "Data Has Been Changed" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Save Changes ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption) Select Case intResponse Case vbYes Call FormSave Case vbNo Case vbCancel Cancel = True Exit Sub End Select End If If moRS.State = adStateOpen Then moRS.Close End If If moRSMat.State = adStateOpen Then moRSMat.Close End If If moRSOptMat.State = adStateOpen Then moRSOptMat.Close End If If moRSOpt.State = adStateOpen Then moRSOpt.Close End If If moRSOptMat.State = adStateOpen Then moRSOptMat.Close End If If moRSProj.State = adStateOpen Then moRSProj.Close End If gintPROJID = 0 gintESTID = 0 Exit Sub Error_EH: If Err = 3219 Then Resume Next Else End If End Sub Private Sub DataHasChanged() cmdSavePlan.Enabled = True cmdNewPlan.Enabled = False End Sub Private Sub cmdFindMat_Click() Dim oRS As Recordset Dim strSQL As String, lngFind As Long Dim strTYPE As String On Error GoTo Error_EH strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtPMInvNo.Text & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then With oRS txtPMInvNo = Field2Str(!inv_no) txtPMDesc = Field2Str(!Desc) txtPMLength = Field2Integer(!calc_amt) txtPMPrice = Field2Str(!price) If !d_flag = "S" Then cboPMDFlag.Text = "Supplier" Else cboPMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) ' Call FindType(cboPMType, strTYPE) If !m_type = "L" Then cboPMType.Text = "Lath" ElseIf !m_type = "B" Then cboPMType.Text = "Brown" ElseIf !m_type = "S" Then cboPMType.Text = "Scratch" ElseIf !m_type = "T" Then cboPMType.Text = "Texture" ElseIf !m_type = "C" Then cboPMType.Text = "CMU" ElseIf !m_type = "P" Then cboPMType.Text = "PreOrder" ElseIf !m_type = "V" Then cboPMType.Text = "Veneer-Stone" ElseIf !m_type = "W" Then cboPMType.Text = "Wrap Typar" ElseIf !m_type = "Z" Then cboPMType.Text = "Z-PreCast" ElseIf !m_type = "E" Then cboPMType.Text = "E_Synthetic" ElseIf !m_type = "J" Then cboPMType.Text = "J-PaintPrep" ElseIf !m_type = "K" Then cboPMType.Text = "K-P-Interior" ElseIf !m_type = "N" Then cboPMType.Text = "N-P-Exterior" ElseIf !m_type = "M" Then cboPMType.Text = "M-PaintFinal" End If If !calc_flag = "M" Then cboPMMetal.Text = "Metal" Else cboPMMetal.Text = "None" End If End With txtPMQty.SetFocus Else Call cmdInventory_Click lngFind = Field2Long(txtPMInvNo) Call ListFindItem2(lstMInventory, lngFind) End If oRS.Close Exit Sub Error_EH: gstrMODULE = "Form Plans - Module cmdFindMat_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdFindOptMat_Click() Dim oRS As Recordset Dim strSQL As String, lngFind As Long Dim strTYPE As String On Error GoTo Error_EH If Len(txtOMInvNo) = 0 Then txtOMInvNo = 1 End If strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtOMInvNo.Text & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount > 0 Then With oRS txtOMInvNo = Field2Str(!inv_no) txtOMDesc = Field2Str(!Desc) txtOMLength = Field2Integer(!calc_amt) If !d_flag = "S" Then cboOMDFlag.Text = "Supplier" Else cboOMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) Call FindType(cboOMType, strTYPE) ' If !m_type = "L" Then ' cboOMType.Text = "Lath" ' ElseIf !m_type = "B" Then ' cboOMType.Text = "Brown" ' ElseIf !m_type = "S" Then ' cboOMType.Text = "Scratch" ' ElseIf !m_type = "T" Then ' cboOMType.Text = "Texture" ' ElseIf !m_type = "C" Then ' cboOMType.Text = "CMU" ' ElseIf !m_type = "P" Then ' cboOMType.Text = "PreOrder" ' End If If !calc_flag = "M" Then cboOMMetal.Text = "Metal" Else cboOMMetal.Text = "None" End If End With txtOMQty.SetFocus Else Call cmdInvList_Click lngFind = Field2Str(txtOMInvNo) Call ListFindItemS2(lstInventory, lngFind) End If oRS.Close Exit Sub Error_EH: gstrMODULE = "Form Plans - Module cmdFindOptMat_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdInventory_Click() lstMInventory.Visible = True Call MInventoryLoad End Sub Private Sub cmdInvList_Click() lstOptions.Visible = False lstInventory.Visible = True Call InventoryLoad End Sub Private Sub InventoryLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE Inv_Type = " & gbytINV_TYPE & " ORDER BY Inv_No" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstInventory.Clear Do Until oRS.EOF With lstInventory strLine = oRS!inv_no & vbTab & oRS!Desc .AddItem strLine .ItemData(.NewIndex) = oRS!inv_no End With oRS.MoveNext Loop oRS.Close If lstInventory.ListCount Then lstInventory.ListIndex = -1 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module InventoryLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub MInventoryLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE Inv_Type = " & gbytINV_TYPE & " ORDER BY Inv_No" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstMInventory.Clear Do Until oRS.EOF With lstMInventory strLine = oRS!inv_no & vbTab & oRS!Desc .AddItem strLine .ItemData(.NewIndex) = oRS!inv_no End With oRS.MoveNext Loop oRS.Close If lstMInventory.ListCount Then lstMInventory.ListIndex = -1 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module mInventoryLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSaveMat_Click() lstPMaterial.Enabled = True mintBOOKMARK = lstPMaterial.ListIndex Call ToggleMatButtons cmdInventory.Visible = False ' cmdFindMat.Visible = False Call MatSave Call MatLoad lstPMaterial.ListIndex = mintBOOKMARK mintBOOKMARK = 0 End Sub Private Sub cmdSavePlan_Click() mintBOOKMARK = lstMod_Elv.ListIndex txtNewModel.Visible = False lblNewModel.Visible = False cmdExit.Enabled = True cmdNewPlan.Enabled = True cmdDelPlan.Enabled = True cmdSavePlan.Enabled = False cmdCopyTakeoff.Enabled = True tabPlans.Enabled = True Call FormSave lstMod_Elv.Enabled = True lstMod_Elv.ListIndex = mintBOOKMARK mintBOOKMARK = 0 End Sub Private Sub lstInventory_DblClick() Dim oRS As Recordset Dim strSQL As String, strTYPE As String On Error GoTo Error_EH strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Calc_Flag, Calc_Amt from tblInvtry where Inv_no = '" & lstInventory.ItemData(lstInventory.ListIndex) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly With oRS txtOMInvNo = Field2Str(!inv_no) txtOMDesc = Field2Str(!Desc) txtOMLength = Field2Integer(!calc_amt) If !d_flag = "S" Then cboOMDFlag.Text = "Supplier" Else cboOMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) Call FindType(cboOMType, strTYPE) ' If !m_type = "L" Then ' cboOMType.Text = "Lath" ' ElseIf !m_type = "B" Then ' cboOMType.Text = "Brown" ' ElseIf !m_type = "S" Then ' cboOMType.Text = "Scratch" ' ElseIf !m_type = "T" Then ' cboOMType.Text = "Texture" ' ElseIf !m_type = "C" Then ' cboOMType.Text = "CMU" ' ElseIf !m_type = "P" Then ' cboOMType.Text = "PreOrder" ' End If If !calc_flag = "M" Then cboOMMetal.Text = "Metal" Else cboOMMetal.Text = "None" End If End With oRS.Close lstInventory.Visible = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module lstInventory_DblClick" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstMInventory_DblClick() Dim oRS As Recordset Dim strSQL As String, strTYPE As String On Error GoTo Error_EH strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Calc_Flag, Calc_Amt, price from tblInvtry where Inv_no = '" & lstMInventory.ItemData(lstMInventory.ListIndex) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly With oRS txtPMInvNo = Field2Str(!inv_no) txtPMDesc = Field2Str(!Desc) txtPMLength = Field2Integer(!calc_amt) txtPMPrice = Field2Str(!price) If !d_flag = "S" Then cboPMDFlag.Text = "Supplier" Else cboPMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) ' Call FindType(cboPMType, strTYPE) If !m_type = "L" Then cboPMType.Text = "Lath" ElseIf !m_type = "B" Then cboPMType.Text = "Brown" ElseIf !m_type = "S" Then cboPMType.Text = "Scratch" ElseIf !m_type = "T" Then cboPMType.Text = "Texture" ElseIf !m_type = "C" Then cboPMType.Text = "CMU" ElseIf !m_type = "P" Then cboPMType.Text = "PreOrder" ElseIf !m_type = "V" Then cboPMType.Text = "Veneer-Stone" ElseIf !m_type = "W" Then cboPMType.Text = "Wrap Typar" ElseIf !m_type = "Z" Then cboPMType.Text = "Z-PreCast" ElseIf !m_type = "E" Then cboPMType.Text = "E_Synthetic" ElseIf !m_type = "J" Then cboPMType.Text = "J-PaintPrep" ElseIf !m_type = "K" Then cboPMType.Text = "K-P-Interior" ElseIf !m_type = "N" Then cboPMType.Text = "N-P-Exterior" ElseIf !m_type = "M" Then cboPMType.Text = "M-PaintFinal" End If If !calc_flag = "M" Then cboPMMetal.Text = "Metal" Else cboPMMetal.Text = "None" End If End With oRS.Close txtPMQty.SetFocus lstMInventory.Visible = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module lstMInventory_DblClick" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSaveOpt_Click() lstOptions.Enabled = True lstOptMatrl.Enabled = True mintBOOKMARK = lstOptions.ListIndex cmdSaveOpt.Enabled = False cmdCopyOpt.Enabled = False cmdDelOpt.Enabled = False cmdAddOpt.Enabled = True cmdAddOptMat.Enabled = True Call OptSave Call OptLoad lstOptions.ListIndex = mintBOOKMARK mintBOOKMARK = 0 End Sub Private Sub cmdSaveOptMat_Click() lstInventory.Visible = False lstOptions.Visible = True lstOptions.Enabled = True lstOptMatrl.Enabled = True mintBOOKMARK = lstOptions.ListIndex cmdAddOptMat.Enabled = True cmdAddOpt.Enabled = True cmdInvList.Visible = False ' cmdFindOptMat.Visible = False cmdSaveOptMat.Enabled = False cmdDelOptMat.Enabled = False Call OptMatSave Call OptLoad lstOptions.ListIndex = mintBOOKMARK mintBOOKMARK = 0 End Sub Private Sub Form_Load() Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 Set moRS = New Recordset Set moRSMat = New Recordset Set moRSOpt = New Recordset Set moRSOptMat = New Recordset Call MTypeLoad(cboPMType) Call MTypeLoad(cboOMType) If gbytSECURITY < 3 Then cmdUpdate.Visible = True chkVerified.Enabled = True End If ' Call ProjLoad Call TextureLoad ' Call ListLoad Call MatLoad Call OptLoad Call OptMatLoad End Sub Private Sub ProjLoad() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID Set moRSProj = New Recordset moRSProj.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly Exit Sub Error_EH: gstrMODULE = "Form Plans - Module ProjLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub TextureLoad() Dim oRSFinish As Recordset Dim strSQL As String, intRows As Integer Dim row, col As Long On Error GoTo Error_EH strSQL = "SELECT AUTOID, Desc FROM tblFinish" Set oRSFinish = New Recordset oRSFinish.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly oRSFinish.MoveLast oRSFinish.MoveFirst intRows = oRSFinish.RecordCount Do Until oRSFinish.EOF cboTexture.AddItem oRSFinish("Desc") cboTexture.ItemData(cboTexture.NewIndex) = Field2Long(oRSFinish("AUTOID")) cboOTexture.AddItem oRSFinish("Desc") cboOTexture.ItemData(cboOTexture.NewIndex) = Field2Long(oRSFinish("AUTOID")) oRSFinish.MoveNext Loop oRSFinish.Close Exit Sub Error_EH: gstrMODULE = "Form Plans - Module TextureLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ListLoad() Dim oRS As Recordset Dim strSQL As String, strProj As String On Error GoTo Error_EH strSQL = "SELECT EST_ID, Mod_Elv from tblPLANS WHERE Proj_ID = " & gintPROJID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstMod_Elv.Clear Do Until oRS.EOF With lstMod_Elv .AddItem Field2Str(oRS!Mod_Elv) .ItemData(.NewIndex) = oRS("est_id") End With oRS.MoveNext Loop oRS.Close If lstMod_Elv.ListCount Then lstMod_Elv.ListIndex = 0 Else gstrFLAG = "D" End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module ListLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShow() Dim strSQL As String Dim oRSMAX As Recordset On Error GoTo Error_EH mboolSHOW = True gintESTID = moRS!est_id txtProject = Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc mstrProj = Trim$(moRSProj!Proj_Code) ' strSQL = "SELECT Max( effdate ) as MAXField FROM tblplanbill WHERE est_id = " & gintESTID 'tblOption" ' Set oRSMAX = New Recordset ' oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' txtEffDate = oRSMAX!maxfield ' oRSMAX.Close txtEffDate = FindMax2("tblPlanBill", "effdate", "EST_Id", gintESTID) ' txtEffDate = FindMax6("tblPlanBill", "effdate", "Proj_ID", gintPROJID, "EST_Id", gintESTID) With moRS txtMatYdge = Field2Long(!mat_yds) txt12Foam = Field2Integer(!foam) txtFin2 = Field2Integer(!fin2) txtCMUYdge = Field2Integer(!CMUYDS) txtPNotes = Field2Str(!notes) txtPFAdj = Field2Integer(!f_adj) txtWireAdj = Field2Integer(!w_adj) txtPLAdj = Field2Integer(!l_adj) txt68 = Field2Str2(!Scaf6) txt108 = Field2Str2(!scaf10) chk2Story = Field2CheckBox(!twostory) chkHLNotes = Field2CheckBox(!HLNotes) chkStone = Field2CheckBox(!stone) chkPaint = Field2CheckBox(!Paint) txtPaintSQFT = Field2Str2(!PNT_SQFT) chkOpen = Field2CheckBox(!openflg) If !P_RL Then lblP_RL.Visible = True Else lblP_RL.Visible = False End If chkVerified = Field2CheckBox(!verified) ' chkUpdate = Field2CheckBox(!Update) txtStone = Field2Str2(!ST_SQFT) txtCreate = Format(Field2Str(!Create), "mm/dd/yyyy") & " - " & Field2Str(!createuser) txtUpdate = Format(Field2Str(!Update), "mm/dd/yyyy") & " - " & Field2Str(!LUUser) txtLSave = Format(Field2Str(!LSave), "mm/dd/yyyy") & " - " & Field2Str(!LSUser) txtImport = Format(Field2Str(!import), "mm/dd/yyyy") & " - " & Field2Str(!imuser) & " - " & Field2Str(!Source) ' txtElev = Field2Str(!FileName) Call FindTexture2(Field2Str(!texture), strTYPE) If strTYPE = "" Then cboTexture.ListIndex = -1 Else cboTexture = strTYPE End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub MatClear() With moRSMat txtPMInvNo = "0" txtPMDesc = "" txtPMQty = "0" txtPMPrice = "0" txtPMLength = "0" ' cboPMDFlag.Text = "" cboPMDFlag.ListIndex = -1 ' cboPMType.Text = "" cboPMType.ListIndex = -1 ' cboPMMetal.Text = "" cboPMMetal.ListIndex = -1 End With End Sub Private Sub FormShowMat() Dim strTYPE As String On Error GoTo Error_EH mboolSHOW = True With moRSMat txtPMInvNo = Field2Str(!inv_no) txtPMDesc = Field2Str(!Desc) txtPMQty = Field2Str(!qty) txtPMPrice = Format$(Field2Str(!price), "##,###.00") txtPMLength = Field2Integer(!calc_amt) If !d_flag = "S" Then cboPMDFlag.Text = "Supplier" Else cboPMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) ' Call FindType(cboPMType, strTYPE) If !m_type = "L" Then cboPMType.Text = "Lath" ElseIf !m_type = "B" Then cboPMType.Text = "Brown" ElseIf !m_type = "S" Then cboPMType.Text = "Scratch" ElseIf !m_type = "T" Then cboPMType.Text = "Texture" ElseIf !m_type = "C" Then cboPMType.Text = "CMU" ElseIf !m_type = "P" Then cboPMType.Text = "PreOrder" ElseIf !m_type = "V" Then cboPMType.Text = "Veneer-Stone" ElseIf !m_type = "W" Then cboPMType.Text = "Wrap Typar" ElseIf !m_type = "Z" Then cboPMType.Text = "Z-PreCast" ElseIf !m_type = "E" Then cboPMType.Text = "E_Synthetic" ElseIf !m_type = "J" Then cboPMType.Text = "J-PaintPrep" ElseIf !m_type = "K" Then cboPMType.Text = "K-P-Interior" ElseIf !m_type = "N" Then cboPMType.Text = "N-P-Exterior" ElseIf !m_type = "M" Then cboPMType.Text = "M-P-PaintFinal" End If If !calc_flag = "M" Then cboPMMetal.Text = "Metal" Else cboPMMetal.Text = "None" End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module FormShowMat" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub MatSave() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH If moRSMat.State = adStateClosed Then strSQL = "SELECT * FROM tblPlanMat WHERE est_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic oRS.AddNew With oRS !Proj_ID = gintPROJID !est_id = gintESTID !inv_no = Str2Field(txtPMInvNo) !Desc = Str2Field(txtPMDesc) !qty = Str2Field(txtPMQty) !price = Str2Field(txtPMPrice) !calc_amt = Integer2Field(txtPMLength) If cboPMDFlag.Text = "Supplier" Then !d_flag = "S" ElseIf cboPMDFlag.Text = "Yard" Then !d_flag = "Y" End If !m_type = Left$(cboPMType.Text, 1) ' If cboPMType.Text = "Lath" Then ' !m_type = "L" ' ElseIf cboPMType.Text = "Brown" Then ' !m_type = "B" ' ElseIf cboPMType.Text = "Scratch" Then ' !m_type = "S" ' ElseIf cboPMType.Text = "Texture" Then ' !m_type = "T" ' ElseIf cboPMType.Text = "CMU" Then ' !m_type = "C" ' ElseIf cboPMType.Text = "PreOrder" Then ' !m_type = "P" ' End If If cboPMMetal.Text = "Metal" Then !calc_flag = "M" ElseIf cboPMMetal.Text = "None" Then !calc_flag = "" End If End With oRS.Update oRS.Close Call MatLoad If mboolAdding Then mboolAdding = False End If Exit Sub End If If mboolAdding Then moRSMat.AddNew End If With moRSMat !Proj_ID = gintPROJID !est_id = gintESTID !inv_no = Str2Field(txtPMInvNo) !Desc = Str2Field(txtPMDesc) !qty = Str2Field(txtPMQty) !price = Str2Field(txtPMPrice) !calc_amt = Integer2Field(txtPMLength) If cboPMDFlag.Text = "Supplier" Then !d_flag = "S" ElseIf cboPMDFlag.Text = "Yard" Then !d_flag = "Y" End If !m_type = Left$(cboPMType.Text, 1) ' If cboPMType.Text = "Lath" Then ' !m_type = "L" ' ElseIf cboPMType.Text = "Brown" Then ' !m_type = "B" ' ElseIf cboPMType.Text = "Scratch" Then ' !m_type = "S" ' ElseIf cboPMType.Text = "Texture" Then ' !m_type = "T" ' ElseIf cboPMType.Text = "CMU" Then ' !m_type = "C" ' ElseIf cboPMType.Text = "PreOrder" Then ' !m_type = "P" ' End If If cboPMMetal.Text = "Metal" Then !calc_flag = "M" ElseIf cboPMMetal.Text = "None" Then !calc_flag = "" End If End With moRSMat.Update If mboolAdding Then mboolAdding = False End If Exit Sub Error_EH: Call ErrorHandler(moRSMat.ActiveConnection) Exit Sub End Sub Private Sub FormShowOpt() On Error GoTo Error_EH mboolSHOW = True gintOPTID = moRSOpt!OPTID With moRSOpt txtOYdge = Field2Integer(!Yardage) txtODesc = Field2Str(!Desc) txtOFin2 = Field2Integer(!fin2) txtOFAdj = Field2Integer(!f_adj) ' txtBillAmt = Field2Integer(!Amt) txtNote = Field2Str(!notes) txtElev = Field2Str(!FileName) chkOStone = Field2CheckBox(!ostone) txtOSt_SqFt = Field2Str2(!OSt_SqFt) txtO68 = Field2Str2(!Scaf6) txtO108 = Field2Str2(!scaf10) chkInv = Field2CheckBox(!invoice) Call FindTexture2(Field2Str(!texture), strTYPE) If strTYPE = "" Then cboOTexture.ListIndex = -1 Else cboOTexture = strTYPE End If lblOEffDate = Field2Str(!effdate) lblOptNum = "Option Number " & Trim(Field2Str(!OPTID)) lblTOptID = "T_Option Number " & Trim(Field2Str(!T_OptID)) If mboolOPTUSED Then lblOptUsed.Visible = True ElseIf mboolOPTUSED = False Then lblOptUsed.Visible = False End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module FormShowOpt" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OptSave() Dim oRSMAX As Recordset Dim oRS As Recordset Dim strSQL As String On Error GoTo Error_EH If moRSOpt.State = adStateClosed Then strSQL = "SELECT * FROM tblPOption WHERE est_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic oRS.AddNew oRS!est_id = gintESTID oRS!Yardage = Integer2Field(txtOYdge) oRS!Desc = Str2Field(txtODesc) oRS!fin2 = Integer2Field(txtOFin2) oRS!f_adj = Integer2Field(txtOFAdj) ' oRS!Amt = Integer2Field(txtBillAmt) oRS!notes = Str2Field(txtNote) oRS!FileName = Str2Field(txtElev) oRS!ostone = chkOStone oRS!OSt_SqFt = Integer2Field(txtOSt_SqFt) oRS!Updated = Date oRS!U_USER = gstrLOGIN oRS!C_USER = gstrLOGIN Call FindTexture(cboOTexture, strTYPE) oRS!texture = strTYPE oRS.Update Call AddOptBill Call OptLoad If mboolAdding Then mboolAdding = False End If Exit Sub End If If mboolAdding Then moRSOpt.AddNew ' Call AddOptBill End If If mboolCopy Then moRSOpt.AddNew moRSOpt!est_id = mintESTID moRSOpt!C_USER = gstrLOGIN Else moRSOpt!est_id = gintESTID End If moRSOpt!Yardage = Integer2Field(txtOYdge.Text) moRSOpt!Desc = Str2Field(txtODesc.Text) moRSOpt!fin2 = Integer2Field(txtOFin2.Text) moRSOpt!f_adj = Integer2Field(txtOFAdj.Text) ' moRSOpt!Amt = Integer2Field(txtBillAmt) moRSOpt!notes = Str2Field(txtNote) moRSOpt!FileName = Str2Field(txtElev) moRSOpt!ostone = chkOStone moRSOpt!OSt_SqFt = Integer2Field(txtOSt_SqFt) moRSOpt!U_USER = gstrLOGIN moRSOpt!Updated = Date Call FindTexture(cboOTexture, strTYPE) moRSOpt!texture = strTYPE moRSOpt.Update strSQL = "SELECT Max(OPTID) as MAXOptid from tblPOption" Set oRSMAX = New Recordset oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = oRSMAX!maxoptid oRSMAX.Close If mboolAdding Then Call AddOptBill mboolAdding = False End If If mboolCopy Then Call AddOptBill Call CopyOptMat mboolCopy = False End If Exit Sub Error_EH: Call ErrorHandler(moRSOpt.ActiveConnection) Exit Sub End Sub Private Sub OptClear() txtOYdge = 0 txtODesc = "" txtOFin2 = 0 txtOFAdj = 0 ' txtBillAmt = 0 txtNote = "" txtElev = "" cboOTexture.ListIndex = -1 End Sub Private Sub FormShowOptMat() Dim strTYPE As String On Error GoTo Error_EH mboolSHOW = True With moRSOptMat txtOMInvNo = Field2Str(!inv_no) txtOMDesc = Field2Str(!Desc) txtOMQty = Field2Str(!qty) txtOMLength = Field2Integer(!calc_amt) If !d_flag = "S" Then cboOMDFlag.Text = "Supplier" Else cboOMDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) Call FindType(cboOMType, strTYPE) If !calc_flag = "M" Then cboOMMetal.Text = "Metal" Else cboOMMetal.Text = "None" End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Plans - Module FormShowOptMat" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OptMatSave() Dim oRS As Recordset Dim strSQL As String On Error GoTo Error_EH If moRSOptMat.State = adStateClosed Then strSQL = "SELECT * FROM tblPOMatrl WHERE optid = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic oRS.AddNew oRS!Proj_ID = gintPROJID oRS!OPTID = gintOPTID oRS!inv_no = Str2Field(txtOMInvNo) oRS!Desc = Str2Field(txtOMDesc) oRS!qty = Str2Field(txtOMQty) oRS!calc_amt = Integer2Field(txtOMLength) If cboOMDFlag.Text = "Supplier" Then oRS!d_flag = "S" ElseIf cboOMDFlag.Text = "Yard" Then oRS!d_flag = "Y" End If oRS!m_type = Left$(cboOMType.Text, 1) If cboOMMetal.Text = "Metal" Then oRS!calc_flag = "M" ElseIf cboOMMetal.Text = "None" Then oRS!calc_flag = "" End If oRS.Update If mboolAdding Then mboolAdding = False End If Exit Sub End If If mboolAdding Then moRSOptMat.AddNew End If moRSOptMat!Proj_ID = gintPROJID moRSOptMat!OPTID = gintOPTID moRSOptMat!inv_no = Str2Field(txtOMInvNo) moRSOptMat!Desc = Str2Field(txtOMDesc) moRSOptMat!qty = Str2Field(txtOMQty) moRSOptMat!calc_amt = Integer2Field(txtOMLength) If cboOMDFlag.Text = "Supplier" Then moRSOptMat!d_flag = "S" ElseIf cboOMDFlag.Text = "Yard" Then moRSOptMat!d_flag = "Y" End If moRSOptMat!m_type = Left$(cboOMType.Text, 1) If cboOMMetal.Text = "Metal" Then moRSOptMat!calc_flag = "M" ElseIf cboOMMetal.Text = "None" Then moRSOptMat!calc_flag = "" End If moRSOptMat.Update If mboolAdding Then mboolAdding = False End If Exit Sub Error_EH: Call ErrorHandler(moRSOpt.ActiveConnection) Exit Sub End Sub Private Sub CopyOptMat() Dim oRS As Recordset Dim strSQL As String On Error GoTo Error_EH strSQL = "Select * from tblPOMatrl where OPTID = " & gintOPTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF If mboolCopy Then moRSOptMat.AddNew End If With oRS moRSOptMat!OPTID = mintOPTID moRSOptMat!inv_no = Field2Str(!inv_no) moRSOptMat!Desc = Field2Str(!Desc) moRSOptMat!qty = Field2Str(!qty) moRSOptMat!calc_amt = Field2Integer(!calc_amt) moRSOptMat!d_flag = Field2Str(!d_flag) moRSOptMat!m_type = Field2Str(!m_type) moRSOptMat!calc_flag = Field2Str(!calc_flag) moRSOptMat.Update End With oRS.MoveNext Loop If mboolAdding Then mboolAdding = False End If oRS.Close Exit Sub Error_EH: Call ErrorHandler(moRSOpt.ActiveConnection) Exit Sub End Sub Private Sub OptMatClear() txtOMInvNo = 0 txtOMDesc = "" txtOMQty = "0" txtOMLength = "0" cboOMDFlag.ListIndex = -1 cboOMType.ListIndex = -1 cboOMMetal.ListIndex = -1 End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH If mboolAdding Then moRS.AddNew moRS!Mod_Elv = Str2Field(txtNewModel.Text) moRS!Proj_ID = gintPROJID moRS!createuser = gstrLOGIN End If Call FieldsSave moRS.Update If mboolAdding Then Call AddBill mboolAdding = False cmdExit.Caption = "E&xit" End If Call ListLoad ' Call ToggleButtons chkUpdate = vbUnchecked Exit Sub Error_EH: Call ErrorHandler(moRS.ActiveConnection) Exit Sub End Sub Private Sub AddBill() Dim lngESTID As Long Dim strSQL As String, oRS As Recordset lngESTID = FindMax("tblplans", "est_id") moRSPB.AddNew moRSPB!est_id = lngESTID moRSPB!Proj_ID = gintPROJID moRSPB!Mod_Elv = Str2Field(txtNewModel.Text) moRSPB!effdate = txtEffDate moRSPB!Wrap = moRSProj!Wrap moRSPB!WPctg = moRSProj!WPctg ' moRSPB!C_USER = gstrLOGIN moRSPB.Update strSQL = "Select * FROM tblPROJDATE" 'WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate ' strSQL = "Select * FROM tblPROJDATE WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic On Error Resume Next If Not oRS.EOF Then oRS.AddNew oRS!Proj_ID = gintPROJID oRS!startdate = txtEffDate oRS.Update End If On Error GoTo 0 End Sub Private Sub AddBill2() Dim lngESTID As Long Dim strSQL As String, oRS As Recordset, strMODELV As String lngESTID = FindMax("tblplans", "est_id") moRSPB.AddNew moRSPB!est_id = lngESTID moRSPB!Proj_ID = gintPROJID strMODELV = lstMod_Elv.Text moRSPB!Mod_Elv = strMODELV moRSPB!effdate = txtEffDate moRSPB!Wrap = moRSProj!Wrap moRSPB!WPctg = moRSProj!WPctg ' moRSPB!C_USER = gstrLOGIN moRSPB.Update strSQL = "Select * FROM tblPROJDATE" 'WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate ' strSQL = "Select * FROM tblPROJDATE WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic On Error Resume Next If Not oRS.EOF Then oRS.AddNew oRS!Proj_ID = gintPROJID oRS!startdate = txtEffDate oRS.Update End If On Error GoTo 0 End Sub Private Sub AddDate() Dim lngESTID As Long Dim strSQL As String, oRS As Recordset strSQL = "Select * FROM tblPROJDATE" 'WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate ' strSQL = "Select * FROM tblPROJDATE WHERE Proj_id = " & gintPROJID & " and effdate = " & txtEffDate Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic On Error Resume Next If Not oRS.EOF Then oRS.AddNew oRS!Proj_ID = gintPROJID oRS!startdate = mstrEffDate oRS.Update End If On Error GoTo 0 End Sub Private Sub AddOptBill() Dim lngOPTID As Long Dim strSQL As String, oRS As Recordset On Error GoTo Error_EH lngOPTID = FindMax("tblpoption", "OptID") moRSPOB.AddNew If mboolCopy Then moRSPOB!est_id = mintESTID Else moRSPOB!est_id = gintESTID End If moRSPOB!OPTID = lngOPTID If txtODesc = "0" Or txtODesc = "" Or txtODesc = " " Then strSQL = "Select * FROM tblPOption WHERE OptId = " & lngOPTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' On Error Resume Next If Not oRS.EOF Then moRSPOB!Desc = Str2Field(oRS!Desc) End If Else moRSPOB!Desc = Str2Field(txtODesc) End If ' moRSPOB!Desc = Str2Field(txtODesc) moRSPOB!effdate = txtEffDate moRSPOB!C_USER = gstrLOGIN moRSPOB.Update ' strSQL = "Select * FROM tblPROJDATE" ' Set oRS = New Recordset ' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' On Error Resume Next ' If Not oRS.EOF Then ' oRS.AddNew ' oRS!proj_id = gintPROJID ' oRS!startdate = txtEffDate ' oRS.Update ' End If ' On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form Plans - Module AddOptBill" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub AddOptBill2() Dim lngOPTID As Long 'Dim strSQL As String, oRS As Recordset ' lngOPTID = FindMax("tblpoption", "OptID") lngOPTID = lstOptions.ItemData(lstOptions.ListIndex) On Error Resume Next moRSPOB.AddNew ' If mboolCopy Then ' moRSPOB!est_id = mintESTID ' Else moRSPOB!est_id = gintESTID ' End If moRSPOB!OPTID = lngOPTID moRSPOB!Desc = Str2Field(txtODesc) moRSPOB!effdate = txtEffDate moRSPOB!C_USER = gstrLOGIN moRSPOB.Update lstOptions.ListIndex = (lstOptions.ListIndex + 1) On Error GoTo 0 End Sub Private Sub AddOptBill3() Dim lngOPTID As Long, strDESC As String Dim oRS As Recordset, strSQL As String, intYN As Integer On Error Resume Next intYN = vbNo lngOPTID = lstOptions.ItemData(lstOptions.ListIndex) strSQL = "SELECT * FROM tblPOptBill WHERE OPTID = " & lngOPTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then strDESC = Field2Str(moRSOpt!Desc) Else strDESC = Field2Str(moRSOpt!Desc) End If If oRS.EOF Then intYN = vbYes moRSPOB.AddNew moRSPOB!est_id = gintESTID moRSPOB!OPTID = lngOPTID moRSPOB!Desc = strDESC ' moRSPOB!Desc = Str2Field(txtODesc) moRSPOB!effdate = txtEffDate moRSPOB!C_USER = gstrLOGIN moRSPOB.Update MsgBox "Option Has Been Added To The Billing Grid", vbOKOnly, "Option Copied" Else intYN = vbNo MsgBox "NO OPTION Was Added To The Billing Grid", vbOKOnly, "Option Copy Failed" End If On Error GoTo 0 End Sub Private Sub ToggleButtons() End Sub Private Sub ToggleMatButtons() cmdSaveMat.Enabled = Not cmdSaveMat.Enabled cmdAddMat.Enabled = Not cmdAddMat.Enabled cmdDelMat.Enabled = Not cmdDelMat.Enabled End Sub Private Function FormFind() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblPlans WHERE est_ID = " & lstMod_Elv.ItemData(lstMod_Elv.ListIndex) If moRS.State = adStateOpen Then moRS.Close End If moRS.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRS.EOF Then FormFind = False Else FormFind = True lblEstID = moRS!est_id End If Exit Function Error_EH: gstrMODULE = "Form Plans - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindOpt() As Boolean Dim strSQL As String, strDate As String Dim strSQLL As String, oRSO As Recordset On Error GoTo Error_EH mboolOPTUSED = False strSQL = "SELECT * FROM tblPOption WHERE OPTID = " & lstOptions.ItemData(lstOptions.ListIndex) If moRSOpt.State = adStateOpen Then moRSOpt.Close End If moRSOpt.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSOpt.EOF Then FormFindOpt = False Else strDate = Field2Str(moRSOpt!effdate) If Len(strDate) = 0 Then moRSOpt!effdate = Field2Str(txtEffDate) moRSOpt.Update Call AddOptBill3 End If strSQLL = "SELECT * FROM tblLOPTION WHERE OPT_ID = " & lstOptions.ItemData(lstOptions.ListIndex) Set oRSO = New Recordset oRSO.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic ' strOPTID = Field2Str(oRSO!opt_id) ' strDESC = Field2Str(oRSO!lot_id) If Not oRSO.EOF Then mboolOPTUSED = True moRSOpt!USED = vbTrue moRSOpt.Update Else mboolOPTUSED = False End If FormFindOpt = True End If Exit Function Error_EH: gstrMODULE = "Form Plans - Module FormFindOpt" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindOptMat() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblPOMatrl " strSQL = strSQL & "WHERE OPTID = " & gintOPTID & " and Inv_No = '" & lstOptMatrl.ItemData(lstOptMatrl.ListIndex) & "'" If moRSOptMat.State = adStateOpen Then moRSOptMat.Close End If moRSOptMat.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSOptMat.EOF Then FormFindOptMat = False Else FormFindOptMat = True End If Exit Function Error_EH: gstrMODULE = "Form Plans - Module FormFindOptMat" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindMat() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblPlanMat " strSQL = strSQL & "WHERE Est_Id = " & gintESTID & " AND INV_NO = '" & lstPMaterial.ItemData(lstPMaterial.ListIndex) & "'" If moRSMat.State = adStateOpen Then moRSMat.Close End If moRSMat.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSMat.EOF Then FormFindMat = False Else FormFindMat = True End If Exit Function Error_EH: gstrMODULE = "Form Plans - Module FormFindMat" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub lstMod_Elv_Click() If lstMod_Elv.ListIndex <> -1 Then If FormFind() Then Call FormShow Call MatLoad Call OptLoad Call OptMatLoad If moRS!P_RL Then gboolPSpecialCALC = True End If End If End If End Sub Private Sub FieldsSave() On Error GoTo Error_EH With moRS !verified = chkVerified !mat_yds = Integer2Field(txtMatYdge) !foam = Integer2Field(txt12Foam) !fin2 = Integer2Field(txtFin2) !CMU = Integer2Field(txtCMUYdge) !notes = Str2Field(txtPNotes) !f_adj = Integer2Field(txtPFAdj) !l_adj = Integer2Field(txtPLAdj) !w_adj = Integer2Field(txtWireAdj) !stone = chkStone !Paint = chkPaint !PNT_SQFT = Integer2Field(txtPaintSQFT) !twostory = chk2Story !Scaf6 = Integer2Field(txt68) !scaf10 = Integer2Field(txt108) ' !FileName = Str2Field(txtElev) !ST_SQFT = Integer2Field(txtStone) ' !Update = chkUpdate !LSave = Date !LSUser = gstrLOGIN If chkHLNotes = vbChecked Then !HLNotes = vbChecked ElseIf chkHLNotes = vbUnchecked Then !HLNotes = vbUnchecked End If If chkUpdate Then !Update = Date !LUUser = gstrLOGIN End If Call FindTexture(cboTexture, strTYPE) !texture = strTYPE End With Exit Sub Error_EH: gstrMODULE = "Form Plans - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdNewPlan_Click() Dim strEffDate As String, boolValid As Boolean Dim strSQL As String Dim oRS As Recordset strEffDate = FindMax2("tblProjDate", "startdate", "Proj_ID", gintPROJID) mstrEffDate = InputBox("Enter the Effective Date for This Plan (07/15/2005)", "Effective Date", strEffDate) If Not IsDate(mstrEffDate) Then MsgBox "You Did Not Enter A Valid Date - No Plan Will Be Added", vbOKOnly, "Invalid Date" Exit Sub End If ' strSQL = "SELECT * FROM tblProjDate WHERE Proj_id = " & gintPROJID & " and STARTDATE = " & CDate(mstrEffDate) If IsDate(strEffDate) Then strSQL = "SELECT * FROM tblProjDate WHERE Proj_id = " & gintPROJID & " and STARTDATE = #" & mstrEffDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Else strSQL = "SELECT * FROM tblProjDate WHERE Proj_id = " & gintPROJID '& " and STARTDATE = #" & mstrEffDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic oRS.AddNew oRS!Proj_ID = gintPROJID oRS!startdate = mstrEffDate oRS.Update End If If oRS.EOF Then MsgBox "You Did Not Enter A Valid Effective Date for This Project - No Plan Will Be Added", vbOKOnly, "Invalid Date" Exit Sub End If If IsDate(mstrEffDate) Then txtEffDate = mstrEffDate Else MsgBox "You Did Not Enter A Valid Date - No Plan Will Be Added", vbOKOnly, "Invalid Date" Exit Sub End If mboolAdding = True Call FormClear Call MatClear Call OptClear lstOptions.Clear lstPMaterial.Clear lstOptMatrl.Clear lstMInventory.Clear lstInventory.Clear txtNewModel.Visible = True lblNewModel.Visible = True cmdExit.Caption = "&Cancel" cmdExit.Enabled = True cmdNewPlan.Enabled = False cmdDelPlan.Enabled = False cmdSavePlan.Enabled = True cmdCopyTakeoff.Enabled = False tabPlans.Enabled = False lstMod_Elv.Enabled = False txtNewModel.SetFocus End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String Call ProjLoad Call ListLoad Call OpenBilling If lstMod_Elv.ListCount = 0 Then intResponse = MsgBox("No Plan/Elevation, do you wish to add one?", vbYesNo + vbQuestion, "Add Records") If intResponse = vbYes Then strSQL = "SELECT * FROM tblplans WHERE est_id = 1" Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic txtProject = Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc Call cmdNewPlan_Click cmdCopyTakeoff.Enabled = True Else Unload Me Exit Sub End If End If lblEstID = moRS!est_id chkUpdate = vbUnchecked End Sub Private Sub FormClear() txtMatYdge = 0 txt12Foam = 0 cboTexture.ListIndex = -1 ' cboTexture.Text = "" txtCMUYdge = 0 txtPNotes = "" txtPFAdj = 0 txtPLAdj = 0 txtWireAdj = 0 txtFin2 = 0 txtNote = "" chkStone = vbUnchecked chkPaint = vbUnchecked txtPaintSQFT = 0 txtStone = 0 txtElev = "" End Sub Private Sub MatLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Est_ID, Inv_no, Desc, Qty, D_Flag, M_Type, Calc_Flag from tblPlanMat WHERE est_id = " & gintESTID & " ORDER BY Inv_no" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstPMaterial.Clear Do Until oRS.EOF With lstPMaterial strLine = oRS("D_Flag") & " " & oRS("M_Type") & " " & oRS("Calc_Flag") & vbTab & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc") .AddItem strLine .ItemData(.NewIndex) = oRS("inv_no") End With oRS.MoveNext Loop oRS.Close If lstPMaterial.ListCount Then lstPMaterial.ListIndex = 0 Else txtPMInvNo = "0" txtPMDesc = "" txtPMQty = "0" txtPMPrice = "0" txtPMLength = "0" cboPMDFlag.ListIndex = -1 cboPMType.ListIndex = -1 cboPMMetal.ListIndex = -1 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module MatLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub TakeLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT TOID, Pln_Elv FROM tblTake WHERE proj_id = " & gintPROJID & " ORDER BY Pln_Elv" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstTake.Clear lstTake.Visible = True lblTake.Visible = True lblTake.Caption = "Double Click the Desired Elevation" Do Until oRS.EOF With lstTake .AddItem oRS!pln_elv .ItemData(.NewIndex) = oRS!toid End With oRS.MoveNext Loop oRS.Close If lstTake.ListCount Then lstTake.ListIndex = 0 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module TakeLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OptMatLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT OPTID, Inv_no, Desc, Qty, D_Flag, M_Type, Calc_Flag from tblPOMatrl WHERE optid = " & gintOPTID 'cboProject.ListIndex" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstOptMatrl.Clear Do Until oRS.EOF With lstOptMatrl strLine = oRS("D_Flag") & " " & oRS("M_Type") & " " & oRS("Calc_Flag") & vbTab & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc") .AddItem strLine .ItemData(.NewIndex) = oRS("inv_no") End With oRS.MoveNext Loop oRS.Close If lstOptMatrl.ListCount Then lstOptMatrl.ListIndex = 0 Else txtOMInvNo = "0" txtOMDesc = "" txtOMQty = "0" txtOMLength = "0" cboOMDFlag.ListIndex = -1 cboOMType.ListIndex = -1 cboOMMetal.ListIndex = -1 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module OptMatLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OptLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Est_ID, OPTID, Opt_No, Desc, Yardage from tblPOption WHERE EST_ID = " & gintESTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstOptions.Clear Do Until oRS.EOF With lstOptions strLine = oRS("Yardage") & vbTab & oRS("desc") .AddItem strLine .ItemData(.NewIndex) = oRS("OPTID") End With oRS.MoveNext Loop oRS.Close If lstOptions.ListCount Then lstOptions.ListIndex = 0 Else txtOYdge = "0" txtODesc = "0" txtOFin2 = "0" txtOFAdj = "0" txtNote = "" lstOptMatrl.Clear txtOMInvNo = "0" txtOMDesc = "" txtOMQty = "0" txtOMLength = "0" cboOMDFlag.ListIndex = -1 cboOMType.ListIndex = -1 cboOMMetal.ListIndex = -1 gintOPTID = 0 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module OptLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstMod_Elv_DblClick() cmdSavePlan.Enabled = False cmdNewPlan.Enabled = False End Sub Private Sub lstOptions_Click() On Error GoTo Error_EH If lstOptions.ListIndex <> -1 Then If FormFindOpt() Then gintOPTID = lstOptions.ItemData(lstOptions.ListIndex) Call FormShowOpt Call OptMatLoad If lstOptMatrl.ListIndex <> -1 Then If FormFindOptMat() Then Call FormShowOptMat Else lstOptMatrl.Clear txtOMInvNo = "0" txtOMDesc = "" txtOMQty = "0" txtOMLength = "0" cboOMDFlag.Text = "" cboOMType.Text = "" cboOMMetal.Text = "" End If End If Else lstOptions.Clear txtOYdge = "0" txtODesc = "" txtOFin2 = "0" txtOFAdj = "0" txtNote = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module lstOptions_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstOptions_DblClick() cmdAddOpt.Enabled = False cmdSaveOpt.Enabled = True cmdCopyOpt.Enabled = True cmdDelOpt.Enabled = True cmdAddOptMat.Enabled = False End Sub Private Sub lstOptMatrl_Click() On Error GoTo Error_EH If lstOptMatrl.ListIndex <> -1 Then If FormFindOptMat() Then Call FormShowOptMat Else lstOptMatrl.Clear txtOMInvNo = "0" txtOMDesc = "" txtOMQty = "0" txtOMLength = "0" cboOMDFlag.Text = "" cboOMType.Text = "" cboOMMetal.Text = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module lstOptMatrl_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstOptMatrl_DblClick() cmdAddOptMat.Enabled = False cmdAddOpt.Enabled = False cmdDelOptMat.Enabled = True cmdSaveOptMat.Enabled = True End Sub Private Sub lstPMaterial_Click() On Error GoTo Error_EH If lstPMaterial.ListIndex <> -1 Then If FormFindMat() Then Call FormShowMat Else lstPMaterial.Clear txtPMInvNo = "0" txtPMDesc = "" txtPMQty = "0" txtPMPrice = "0" txtPMLength = "0" cboPMDFlag.Text = "" cboPMType.Text = "" cboPMMetal.Text = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module lstPMaterial_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstPMaterial_DblClick() cmdSaveMat.Enabled = True cmdDelMat.Enabled = True cmdAddMat.Enabled = False End Sub Private Sub lstTake_DblClick() gintTOID = lstTake.ItemData(lstTake.ListIndex) mstrMODEL = lstTake.List(lstTake.ListIndex) Call CopyTake Call ListLoad Call MatLoad Call OptLoad Call OptMatLoad lstTake.Visible = False lblTake.Visible = False End Sub Private Sub txt108_GotFocus() Call FieldSelect(txt108) End Sub Private Sub txt12Foam_GotFocus() Call FieldSelect(txt12Foam) End Sub Private Sub txt68_GotFocus() Call FieldSelect(txt68) End Sub 'Private Sub txtBillAmt_GotFocus() ' Call FieldSelect(txtBillAmt) 'End Sub Private Sub txtCMUYdge_GotFocus() Call FieldSelect(txtCMUYdge) End Sub Private Sub txtElev_GotFocus() Call FieldSelect(txtElev) End Sub Private Sub txtElev_LostFocus() txtElev = UCase(txtElev) End Sub Private Sub txtFin2_GotFocus() Call FieldSelect(txtFin2) End Sub Private Sub txtMatYdge_GotFocus() Call FieldSelect(txtMatYdge) End Sub Private Sub txtNew_LostFocus() cmdUpdate.SetFocus End Sub Private Sub txtNewModel_LostFocus() txtNewModel.Text = UCase(txtNewModel.Text) End Sub Private Sub txtNote_LostFocus() txtNote.Text = UCase(txtNote.Text) End Sub Private Sub txtODesc_GotFocus() Call FieldSelect(txtODesc) End Sub Private Sub txtODesc_LostFocus() txtODesc.Text = UCase(txtODesc.Text) End Sub Private Sub txtOFAdj_GotFocus() Call FieldSelect(txtOFAdj) End Sub Private Sub txtOFin2_GotFocus() Call FieldSelect(txtOFin2) End Sub Private Sub txtOMDesc_GotFocus() Call FieldSelect(txtOMDesc) End Sub Private Sub txtOMDesc_LostFocus() txtOMDesc.Text = UCase(txtOMDesc.Text) End Sub Private Sub txtOMInvNo_GotFocus() Call FieldSelect(txtOMInvNo) End Sub Private Sub txtOMLength_GotFocus() Call FieldSelect(txtOMLength) End Sub Private Sub txtOMQty_GotFocus() Call FieldSelect(txtOMQty) End Sub Private Sub txtOSt_SqFt_GotFocus() Call FieldSelect(txtOSt_SqFt) End Sub Private Sub txtOYdge_GotFocus() Call FieldSelect(txtOYdge) End Sub Private Sub txtPFAdj_GotFocus() Call FieldSelect(txtPFAdj) End Sub Private Sub txtPLAdj_GotFocus() Call FieldSelect(txtPLAdj) End Sub Private Sub txtPMDesc_GotFocus() Call FieldSelect(txtPMDesc) End Sub Private Sub txtPMDesc_LostFocus() txtPMDesc.Text = UCase(txtPMDesc.Text) End Sub Private Sub txtPMInvNo_GotFocus() Call FieldSelect(txtPMInvNo) End Sub Private Sub txtPMLength_GotFocus() Call FieldSelect(txtPMLength) End Sub Private Sub txtPMPrice_GotFocus() Call FieldSelect(txtPMPrice) End Sub Private Sub txtPMQty_GotFocus() Call FieldSelect(txtPMQty) End Sub Private Sub cmdCProj_Click() Call ProjectLoad lstProject.SetFocus End Sub Private Sub lstProject_DblClick() Dim strMODEL As String, strSQL As String Dim lngESTID As Long Dim oRS As Recordset On Error GoTo Error_EH mstrEffDate = InputBox("Enter the Effective Date for This Copied Plan", "Effective Date", Date) mintPROJID = lstProject.ItemData(lstProject.ListIndex) ' mstrPROJ = Trim(lstProject.Text) ' mboolCopy = True strMODEL = lstMod_Elv.List(lstMod_Elv.ListIndex) strSQL = "SELECT est_id, proj_id, mod_elv from tblPlans WHERE Proj_id = " & mintPROJID & " and mod_elv = '" & strMODEL & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If oRS.RecordCount = 0 Then ' txtNewElv = UCase(strMODEL) ' mboolCopy = True moRS.AddNew moRS!Proj_ID = mintPROJID moRS!Mod_Elv = strMODEL moRS!createuser = gstrLOGIN Call FieldsSave moRS!LUUser = gstrLOGIN moRS!Update = Date moRS!Source = mstrProj moRS!import = Date moRS!imuser = gstrLOGIN moRS.Update lngESTID = FindMax("tblplans", "est_id") moRSPB.AddNew moRSPB!est_id = lngESTID moRSPB!Proj_ID = mintPROJID moRSPB!Mod_Elv = strMODEL moRSPB!Create = Date moRSPB!Wrap = moRSProj!Wrap moRSPB!WPctg = moRSProj!WPctg moRSPB.Update Call CopyTMat Call CopyTOpt lstProject.Visible = False lblTake.Visible = False Else MsgBox "The Model/Elevation you selected is already being used in new Project. Verify the Project Code and try again!", vbOKOnly, "Invalid Project Code" cmdAddOpt.Enabled = True cmdSaveOpt.Enabled = False cmdDelOpt.Enabled = False cmdCopyOpt.Enabled = False cmdAddOptMat.Enabled = True lstProject.Visible = False lblTake.Visible = False ' mboolCopy = False Exit Sub End If Exit Sub Error_EH: gstrMODULE = "Form Plan - Module lstProject_DblClick" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CopyTOpt() Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset, oRSC As Recordset Dim strSQL As String, strSELECT As String, strCOPY As String On Error GoTo Error_EH strCOPY = "SELECT * FROM tblPOption where optid = 1" Set oRSC = New Recordset oRSC.Open strCOPY, goConn, adOpenKeyset, adLockOptimistic strSQL = "SELECT * FROM tblPOption where Est_id = " & gintESTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF gintOPTID = oRS!OPTID With oRS oRSC.AddNew oRSC!est_id = mintESTID oRSC!Desc = Field2Str(oRS!Desc) oRSC!Yardage = Field2Integer(oRS!Yardage) oRSC!Amt = Field2Str2(oRS!Amt) oRSC!texture = Field2Str(oRS!texture) oRSC!fin2 = Field2Integer(oRS!fin2) oRSC!f_adj = Field2Integer(oRS!f_adj) oRSC!notes = Field2Str(oRS!notes) oRSC!ostone = oRS!ostone oRSC!OSt_SqFt = Field2Str2(oRS!OSt_SqFt) oRSC.Update End With strCOPY = "SELECT * FROM tblPOMatrl where optid = 1" Set oRSSS = New Recordset oRSSS.Open strCOPY, goConn, adOpenKeyset, adLockOptimistic strSELECT = "SELECT MAX(optid) as MAXoptid FROM tblPOption" Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly mintOPTID = oRSS!maxoptid moRSPOB.AddNew moRSPOB!est_id = mintESTID moRSPOB!OPTID = mintOPTID moRSPOB!Desc = Field2Str(oRS!Desc) moRSPOB!created = Date moRSPOB!C_USER = gstrLOGIN moRSPOB!effdate = mstrEffDate moRSPOB.Update strSELECT = "SELECT * FROM tblPOMatrl where optid = " & gintOPTID Set oRSS = New Recordset oRSS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRSS.EOF With oRSS oRSSS.AddNew oRSSS!OPTID = mintOPTID oRSSS!Proj_ID = mintPROJID oRSSS!inv_no = Field2Str(!inv_no) oRSSS!Desc = Field2Str(!Desc) oRSSS!qty = Field2Str2(!qty) oRSSS!d_flag = Field2Str(!d_flag) oRSSS!m_type = Field2Str(!m_type) oRSSS!calc_flag = Field2Str(!calc_flag) oRSSS!calc_amt = Field2Str(!calc_amt) oRSSS.Update End With oRSS.MoveNext Loop oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form Plan - Module CopyTOpt" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CopyTMat() Dim oRS As Recordset, oRSS As Recordset, oRSC As Recordset Dim strSQL As String, strSELECT As String, strCOPY As String On Error GoTo Error_EH strCOPY = "SELECT * FROM tblPlanMat where Est_id = 1" Set oRSC = New Recordset oRSC.Open strCOPY, goConn, adOpenKeyset, adLockOptimistic strSQL = "SELECT est_id FROM tblPlans where proj_id = " & mintPROJID & " and mod_elv = '" & lstMod_Elv.List(lstMod_Elv.ListIndex) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly mintESTID = Field2Long(oRS!est_id) strSQL = "SELECT * FROM tblPlanMat where est_id = " & gintESTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF With oRS oRSC.AddNew oRSC!est_id = mintESTID oRSC!Proj_ID = mintPROJID oRSC!inv_no = Field2Str(oRS!inv_no) oRSC!Desc = Field2Str(oRS!Desc) oRSC!qty = Field2Str2(oRS!qty) oRSC!price = Field2Str2(oRS!price) oRSC!unit = Field2Str(oRS!unit) oRSC!d_flag = Field2Str(oRS!d_flag) oRSC!m_type = Field2Str(oRS!m_type) oRSC!calc_flag = Field2Integer(oRS!calc_flag) oRSC!calc_amt = Field2Integer(oRS!calc_amt) oRSC.Update End With oRS.MoveNext Loop Exit Sub Error_EH: gstrMODULE = "Form Plan - Module CopyTMat" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ProjectLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Proj_id, Proj_Code FROM tblProject ORDER BY Proj_Code" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstProject.Clear lstProject.Visible = True lblTake.Visible = True lblTake.Caption = "Double Click the Desired Project" Do Until oRS.EOF With lstProject .AddItem oRS!Proj_Code .ItemData(.NewIndex) = oRS!Proj_ID End With oRS.MoveNext Loop oRS.Close If lstProject.ListCount Then lstProject.ListIndex = 0 End If Exit Sub Error_EH: gstrMODULE = "Form Plans - Module ProjectLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub txtPNotes_LostFocus() txtPNotes.Text = UCase(txtPNotes.Text) End Sub Private Sub txtWireAdj_GotFocus() Call FieldSelect(txtWireAdj) End Sub