VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Begin VB.Form frmRepair Caption = "Repair Schedule" ClientHeight = 8850 ClientLeft = 60 ClientTop = 345 ClientWidth = 11850 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 8850 ScaleWidth = 11850 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtSeq Alignment = 1 'Right Justify Height = 315 Left = 1020 TabIndex = 68 Top = 8220 Width = 615 End Begin VB.TextBox txtWorkers Height = 315 Left = 6300 TabIndex = 20 Top = 4980 Width = 1095 End Begin VB.CommandButton cmdDelete Caption = "&Delete Repair" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 10620 TabIndex = 63 Top = 3480 Width = 1200 End Begin Crystal.CrystalReport crRepair Left = 2640 Top = 7800 _ExtentX = 741 _ExtentY = 741 _Version = 348160 WindowControlBox= -1 'True WindowMaxButton = -1 'True WindowMinButton = -1 'True PrintFileLinesPerPage= 60 End Begin VB.CommandButton cmdPrint Caption = "&Print Daily Sheet" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 9300 TabIndex = 62 Top = 3480 Width = 1275 End Begin VB.CommandButton cmdGetLot Caption = "&Get Lot" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 7980 TabIndex = 61 Top = 3480 Width = 1275 End Begin VB.ListBox lstProject Height = 2595 Left = 7080 Sorted = -1 'True TabIndex = 60 Top = 600 Visible = 0 'False Width = 4695 End Begin VB.ListBox lstLot Height = 2790 Left = 7080 Sorted = -1 'True TabIndex = 59 Top = 600 Visible = 0 'False Width = 4695 End Begin VB.CommandButton cmdAdd Caption = "&Add" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 4020 TabIndex = 58 Top = 3480 Width = 1275 End Begin VB.CommandButton cmdExit Caption = "&Exit" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6660 TabIndex = 57 Top = 3480 Width = 1275 End Begin VB.CommandButton cmdSave Caption = "&Save" 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 = 495 Left = 5340 TabIndex = 56 Top = 3480 Width = 1275 End Begin VB.ComboBox cboDArea Height = 315 ItemData = "frmRepair.frx":0000 Left = 1020 List = "frmRepair.frx":0022 Style = 2 'Dropdown List TabIndex = 14 Top = 7860 Width = 1215 End Begin VB.TextBox txtNotes Height = 1335 Left = 4080 MultiLine = -1 'True TabIndex = 31 Top = 7380 Width = 7635 End Begin VB.TextBox txtDesc Height = 1035 Left = 4080 MaxLength = 250 MultiLine = -1 'True TabIndex = 30 Top = 6180 Width = 5595 End Begin VB.TextBox txtBPhone Height = 315 Left = 960 MaxLength = 14 TabIndex = 11 Top = 5700 Width = 1215 End Begin VB.TextBox txtEstTime Alignment = 1 'Right Justify Height = 315 Left = 8400 MaxLength = 3 TabIndex = 22 Top = 5340 Width = 1215 End Begin VB.TextBox txtStory Alignment = 1 'Right Justify Height = 315 Left = 8400 MaxLength = 1 TabIndex = 21 Top = 4980 Width = 1215 End Begin VB.TextBox txtBCWho Height = 315 Left = 6120 MaxLength = 20 TabIndex = 23 Top = 5700 Width = 3495 End Begin VB.Frame frmRepair Caption = "Work Type" Height = 2295 Left = 9840 TabIndex = 36 Top = 4260 Width = 1875 Begin VB.CheckBox chkBC Caption = "Back Charge:" Height = 375 Left = 300 TabIndex = 29 Top = 1800 Width = 1400 End Begin VB.CheckBox chkWarrenty Caption = "Warranty:" Height = 315 Left = 300 TabIndex = 28 Top = 1500 Width = 1400 End Begin VB.CheckBox chkWO Caption = "WorkOrder:" Height = 315 Left = 300 TabIndex = 27 Top = 1200 Width = 1400 End Begin VB.CheckBox chkYr2 Caption = "2nd Year End:" Height = 375 Left = 300 TabIndex = 26 Top = 840 Width = 1400 End Begin VB.CheckBox chkYr1 Caption = "1st Year End:" Height = 315 Left = 300 TabIndex = 25 Top = 540 Width = 1400 End Begin VB.CheckBox chkPunch Caption = "Punch:" Height = 255 Left = 300 TabIndex = 24 Top = 240 Width = 1400 End End Begin VB.TextBox txtVWPSuper Height = 315 Left = 8400 MaxLength = 14 TabIndex = 18 Top = 4260 Width = 1215 End Begin VB.TextBox txtHPhone Height = 315 Left = 3300 MaxLength = 14 TabIndex = 17 Top = 4980 Width = 1215 End Begin VB.TextBox txtHAddress Height = 315 Left = 3300 MaxLength = 30 TabIndex = 16 Top = 4620 Width = 3315 End Begin VB.TextBox txtHName Height = 315 Left = 3300 MaxLength = 20 TabIndex = 15 Top = 4260 Width = 3315 End Begin VB.TextBox txtBillAmt Alignment = 1 'Right Justify Height = 315 Left = 960 MaxLength = 10 TabIndex = 34 Top = 7500 Width = 1215 End Begin VB.TextBox txtBillDate Height = 315 Left = 960 MaxLength = 10 TabIndex = 33 Top = 7140 Width = 1215 End Begin VB.CheckBox chkBilled Alignment = 1 'Right Justify Caption = "Billed:" Height = 195 Left = 420 TabIndex = 32 Top = 6840 Width = 1035 End Begin VB.TextBox txtBPOAmt Alignment = 1 'Right Justify Height = 315 Left = 960 MaxLength = 10 TabIndex = 13 Top = 6420 Width = 1215 End Begin VB.TextBox txtBPO Height = 315 Left = 960 MaxLength = 15 TabIndex = 12 Top = 6060 Width = 1215 End Begin VB.TextBox txtBContact Height = 315 Left = 960 MaxLength = 20 TabIndex = 10 Top = 5340 Width = 2175 End Begin VB.TextBox txtCompleted Height = 315 Left = 960 MaxLength = 10 TabIndex = 9 Top = 4620 Width = 1215 End Begin VB.TextBox txtScheduled Height = 315 Left = 960 MaxLength = 10 TabIndex = 8 Top = 4260 Width = 1215 End Begin VB.ComboBox cboArea Height = 315 ItemData = "frmRepair.frx":0073 Left = 4260 List = "frmRepair.frx":0095 Style = 2 'Dropdown List TabIndex = 5 TabStop = 0 'False Top = 120 Width = 1155 End Begin VB.ListBox lstRepair Height = 2790 Left = 180 TabIndex = 3 TabStop = 0 'False Top = 600 Width = 6795 End Begin VB.ComboBox cboRCrew Height = 315 Left = 7200 Style = 2 'Dropdown List TabIndex = 19 Top = 4620 Width = 2415 End Begin MSComCtl2.DTPicker dtpRepairs Height = 315 Left = 1020 TabIndex = 0 TabStop = 0 'False Top = 120 Width = 1515 _ExtentX = 2672 _ExtentY = 556 _Version = 393216 Format = 92078081 CurrentDate = 40544 MaxDate = 55153 MinDate = 36892 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Sequence:" Height = 195 Left = 60 TabIndex = 67 Top = 8280 Width = 780 End Begin VB.Label lblWorkers Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "# of Workers:" Height = 195 Left = 5160 TabIndex = 66 Top = 5040 Width = 975 End Begin VB.Label lblLot BackStyle = 0 'Transparent Height = 255 Left = 2880 TabIndex = 65 Top = 3840 Width = 675 End Begin VB.Label lblProject Height = 255 Left = 180 TabIndex = 64 Top = 3840 Width = 2535 End Begin VB.Label Label1 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Area:" Height = 195 Left = 465 TabIndex = 55 Top = 7980 Width = 375 End Begin VB.Label lblAreaDef Caption = "Nothing in the 'List Area' will display all repairs for the selected Date:" 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 = 5520 TabIndex = 54 Top = 60 Width = 4335 End Begin VB.Label lblNotes 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 = 3360 TabIndex = 53 Top = 7440 Width = 690 End Begin VB.Label lblDesc Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Description of Work:" 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 = 52 Top = 6240 Width = 1770 End Begin VB.Label lblBPhone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Phone:" Height = 195 Left = 330 TabIndex = 51 Top = 5760 Width = 510 End Begin VB.Label lblEstTime Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "# of Minutes to Complete Repair:" Height = 195 Left = 6060 TabIndex = 50 Top = 5400 Width = 2325 End Begin VB.Label lblStory Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "# of Stories:" Height = 195 Left = 7530 TabIndex = 49 Top = 5100 Width = 855 End Begin VB.Label lblBCWho Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Back Charge Who:" Height = 195 Left = 4680 TabIndex = 48 Top = 5820 Width = 1365 End Begin VB.Label lblVWPSuper Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "VWP Superintendent:" Height = 195 Left = 6840 TabIndex = 47 Top = 4380 Width = 1545 End Begin VB.Label lblHPhone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Telephone:" Height = 195 Left = 2385 TabIndex = 46 Top = 5100 Width = 810 End Begin VB.Label lblHAddress Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Address:" Height = 195 Left = 2580 TabIndex = 45 Top = 4740 Width = 615 End Begin VB.Label lblHName Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Name:" Height = 195 Left = 2730 TabIndex = 44 Top = 4380 Width = 465 End Begin VB.Label lblBillDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Billed Date:" Height = 195 Left = 30 TabIndex = 43 Top = 7260 Width = 810 End Begin VB.Label lblBillAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Billed Amt:" Height = 195 Left = 105 TabIndex = 42 Top = 7620 Width = 735 End Begin VB.Label lblHOInfo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Homeowner Information:" Height = 195 Left = 3360 TabIndex = 41 Top = 4020 Width = 1725 End Begin VB.Label lblBAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Amount:" Height = 195 Left = 255 TabIndex = 40 Top = 6540 Width = 585 End Begin VB.Label lblBPO Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "P.O.:" Height = 195 Left = 480 TabIndex = 39 Top = 6180 Width = 360 End Begin VB.Label lblBContact Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Contact:" Height = 195 Left = 240 TabIndex = 38 Top = 5460 Width = 600 End Begin VB.Label lblBuilderInfo AutoSize = -1 'True Caption = "Builder Information:" Height = 195 Left = 840 TabIndex = 37 Top = 5040 Width = 1350 End Begin VB.Label lblCompleted Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Completed:" Height = 195 Left = 135 TabIndex = 35 Top = 4740 Width = 795 End Begin VB.Label lblScheduled Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Scheduled:" Height = 195 Left = 120 TabIndex = 7 Top = 4380 Width = 810 End Begin VB.Label lblProjectLot BorderStyle = 1 'Fixed Single Height = 315 Left = 180 TabIndex = 6 Top = 3480 Width = 3735 End Begin VB.Label lblArea Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "List Area:" Height = 195 Left = 3435 TabIndex = 4 Top = 180 Width = 660 End Begin VB.Label lblCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew:" Height = 195 Left = 6720 TabIndex = 2 Top = 4740 Width = 405 End Begin VB.Label lblRDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Repair Date:" Height = 195 Left = 60 TabIndex = 1 Top = 180 Width = 900 End End Attribute VB_Name = "frmRepair" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSRepair As Recordset Dim moRS As Recordset, moRSProj As Recordset Dim mboolSHOW As Boolean, mboolAdding As Boolean Dim mlngREPAIRID As Long, mintBOOKMARK As Integer Dim mstrPROJLOT As String Private Sub RepairLoad() Dim oRS As Recordset Dim strSQL As String Dim strTYPE As String Dim strLine As String On Error GoTo Error_EH If cboArea.ListIndex = -1 Then strSQL = "SELECT repair_ID, sequence, proj_lot, lot_id, area, punch, yrend1, yrend2, wo, repair from tblRepair WHERE scheduled = #" & CDate(dtpRepairs.Value) & "# ORDER BY Area, sequence" Else strSQL = "SELECT Repair_ID, sequence, proj_lot, lot_id, area, punch, yrend1, yrend2, wo, repair from tblRepair WHERE scheduled = #" & CDate(dtpRepairs.Value) & "# and Area = '" & Left(cboArea.Text, 1) & "' ORDER BY sequence" End If Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstRepair.Clear Do Until oRS.EOF With lstRepair gintLOTID = Field2Str2(oRS!Lot_id) 'Call GetLotInfo If oRS!punch Then strTYPE = "PUNCH " ElseIf oRS!yrend1 Then strTYPE = "1 YEAR END" ElseIf oRS!yrend2 Then strTYPE = "2 YEAR END" ElseIf oRS!wo Then strTYPE = "PO WORK " ElseIf oRS!repair Then strTYPE = "REPAIR " End If strLine = "" strLine = Field2Str(oRS!Area) & " " & Field2Str(oRS!sequence) & vbTab strLine = strLine & strTYPE & vbTab & Field2Str(oRS!proj_lot) ' strLine = strLine & Format(oRS!builder_phone, "???????????") & vbTab & oRS!builder_contact & vbTab & mstrPROJLOT ' strline = str ' strLine = oRS!lot_id '& vbTab & oRS!Desc .AddItem strLine .ItemData(.NewIndex) = oRS!repair_id End With oRS.MoveNext Loop oRS.Close If lstRepair.ListCount Then lstRepair.ListIndex = 0 mlngREPAIRID = lstRepair.ItemData(lstRepair.ListIndex) Else mlngREPAIRID = 0 End If Exit Sub Error_EH: gstrMODULE = "Form Repair - Module RepairLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim oRSRCrew As Recordset Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT RC_ID, Name FROM tblRCrew" Set oRSRCrew = New Recordset oRSRCrew.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly Do Until oRSRCrew.EOF cboRCrew.AddItem oRSRCrew("Name") cboRCrew.ItemData(cboRCrew.NewIndex) = Field2Long(oRSRCrew("RC_ID")) oRSRCrew.MoveNext Loop oRSRCrew.Close ' cboRCrew.ListIndex = 0 Exit Sub Error_EH: gstrMODULE = "Form Repair - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cboArea_Click() Call RepairLoad End Sub Private Sub cboArea_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then cboArea.ListIndex = -1 End If End Sub Private Sub cmdAdd_Click() mboolAdding = True Call FormClear Call ProjectSelect cmdExit.Caption = "&Cancel" cmdExit.Enabled = True cmdSave.Enabled = True lstRepair.Enabled = False lstProject.SetFocus End Sub Private Sub cmdDelete_Click() Dim strSQL As String, strYN As String On Error GoTo Error_EH If Len(txtCompleted) <> 0 Then MsgBox "This Repair Can Not Be Deleted", vbOKOnly, "NO DELETE ALLOWED" Exit Sub End If strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If gconACTION = 3 strSQL = "DELETE * FROM tblrepair WHERE repair_id = " & lstRepair.ItemData(lstRepair.ListIndex) goConn.Execute strSQL ' strSQL = "DELETE * FROM tblLotMatrl WHERE Lot_id = " & gintLOTID ' goConn.Execute strSQL ' moRS.Delete gstrFLAG = "D" Call LotChange(mstrPROJLOT, "Delete Repair") Call RepairLoad Exit Sub Error_EH: gstrMODULE = "Form Repair - Module cmdDelete" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdGetLot_Click() Call GetLotInfo Call cmdSave_Click End Sub Private Sub cmdPrint_Click() Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String On Error GoTo Error_EH If Len(cboArea.Text) = 0 Then MsgBox "You Must Select A Value In The 'List Area' Field", vbOKOnly, "No Area Of Town Selected" Exit Sub End If strMONTH = Format(Month(dtpRepairs.Value), "00") strDAY = Format(Day(dtpRepairs.Value), "00") strYEAR = Year(dtpRepairs.Value) gintPRINT = 1 frmReport.Show 1 strSQL = "{tblREPAIR.scheduled} = date(" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'" crREPAIR.ReportFileName = App.Path & "\DailyRepairs.rpt" crREPAIR.SelectionFormula = strSQL ' crRepair.Destination = crptToWindow crREPAIR.CopiesToPrinter = gintCOPY crREPAIR.Destination = gintDEST crREPAIR.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form Repair - Module cmdPrint_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSave_Click() mintBOOKMARK = lstRepair.ListIndex If Len(cboDArea.Text) = 0 Then MsgBox "You Must Enter The Area Of Town Before Saving", vbOKOnly, "Select An Area" cboDArea.SetFocus Exit Sub End If Call FormSave cmdSave.Enabled = False cmdAdd.Enabled = True lstRepair.Enabled = True If lstRepair.ListIndex > 0 Then lstRepair.ListIndex = mintBOOKMARK End If End Sub Private Sub dtpRepairs_Change() Call RepairLoad If FormFind() Then Call FormShow Else Call FormClear End If End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH ' mboolSETUP = False ' mboolENTER = False ' If gintLOTID = 0 Then ' intResponse = MsgBox("No Lot Information, do you wish to add one?", vbYesNo + vbQuestion, "Add Lot Information") ' If intResponse = vbYes Then ' txtProject = Trim$(moRSProj!proj_code) & " " & moRSProj!proj_desc ' strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = 1" ' Set moRS = New Recordset ' moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' Call cmdAddLot_Click ' Else ' Unload Me ' End If ' End If Exit Sub Error_EH: gstrMODULE = "Form Repair - Module Form_Activate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If Shift = 4 Then Exit Sub End If ' If Field2Str(moRS!l_flg) <> "P" Then ' If Not cmdSaveLotInfo.Enabled Then ' Call DataHasChanged ' End If ' 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 Form_Load() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH Set moRSRepair = New Recordset dtpRepairs.Value = Date Call CrewLoad Call RepairLoad If FormFind() Then Call FormShow Else Call FormClear End If Exit Sub Error_EH: gstrMODULE = "Form Repair - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFind() As Boolean Dim strSQL As String, strPlan As String, strMEMO As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblRepair " strSQL = strSQL & "WHERE Repair_ID = " & mlngREPAIRID If moRSRepair.State = adStateOpen Then moRSRepair.Close End If Set moRSRepair = New Recordset moRSRepair.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRSRepair.EOF Then FormFind = False Else FormFind = True gintLOTID = Field2Str2(moRSRepair!Lot_id) gintPROJID = Field2Str2(moRSRepair!Proj_ID) End If Exit Function Error_EH: gstrMODULE = "Form Repair - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FormShow() Dim mstrAREA As String Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH lblProject.Caption = "" lblLot.Caption = "" mboolSHOW = True strSQL = "Select Proj_Desc FROM tblProject WHERE proj_id = " & gintPROJID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lblProject.Caption = Field2Str(oRS!Proj_Desc) strSQL = "Select Lot_no FROM tblLotInfo WHERE Lot_id = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lblLot.Caption = Field2Str(oRS!lot_no) With moRSRepair txtScheduled = Field2Str(!scheduled) txtCompleted = Field2Str(!completed) txtBContact = Field2Str(!builder_contact) txtBPhone = Field2Str(!builder_phone) txtBPO = Field2Str(!builder_PO) txtBPOAmt = Field2Str(!PO_Amt) txtBillDate = Field2Str(!bill_date) txtBillAmt = Field2Str(!bill_amt) txtHName = Field2Str(!Owner_Name) txtHAddress = Field2Str(!Owner_address) txtSeq = Field2Str2(!sequence) txtHPhone = Field2Str(!Owner_phone) txtVWPSuper = Field2Str(!VWP_Super) txtStory = Field2Str(!storys) txtEstTime = Field2Str(!est_time) txtBCWho = Field2Str(!bc_who) txtDesc = Field2Str(!Desc) txtNotes = Field2Str(!notes) txtWorkers = Field2Str(!crewsize) mstrAREA = Field2Str(!Area) If mstrAREA = "W" Then cboDArea.Text = "West" ElseIf mstrAREA = "N" Then cboDArea.Text = "North" ElseIf mstrAREA = "S" Then cboDArea.Text = "South" ElseIf mstrAREA = "X" Then cboDArea.Text = "Xtra" ElseIf mstrAREA = "2" Then cboDArea.Text = "2-North" ElseIf mstrAREA = "3" Then cboDArea.Text = "3-North" ElseIf mstrAREA = "4" Then cboDArea.Text = "4-South" ElseIf mstrAREA = "5" Then cboDArea.Text = "5-West" ElseIf mstrAREA = "6" Then cboDArea.Text = "6-Stone" ElseIf mstrAREA = "P" Then cboDArea.Text = "Paint" End If chkBilled = Field2CheckBox(!billed) chkPunch = Field2CheckBox(!punch) chkYr1 = Field2CheckBox(!yrend1) chkYr2 = Field2CheckBox(!yrend2) chkWO = Field2CheckBox(!wo) chkWarrenty = Field2CheckBox(!repair) chkBC = Field2CheckBox(!backcharge) cboRCrew.ListIndex = Field2Integer(!repair_crew) - 1 lblProjectLot.Caption = Field2Str(!proj_lot) ' cboRCrew.ListIndex = Field2Long(!repair_crew) End With ' Call GetLotInfo mboolSHOW = False Exit Sub Error_EH: If Err = 3021 Then MsgBox "No Project Was Found = Be Sure To Click The Get Lot Button", vbOKOnly, "No Project" Resume Next End If gstrMODULE = "Form Repair - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FieldsSave() Dim strLOT As String On Error GoTo Error_EH If mboolAdding Then moRSRepair.AddNew moRSRepair!createuser = gstrLOGIN moRSRepair!Proj_ID = gintPROJID moRSRepair!Lot_id = gintLOTID moRSRepair!proj_lot = Field2Str(lblProjectLot.Caption) End If With moRSRepair !scheduled = Str2Field(txtScheduled) !completed = Str2Field(txtCompleted) !builder_contact = Str2Field(txtBContact) !builder_phone = Str2Field(txtBPhone) !builder_PO = Str2Field(txtBPO) !PO_Amt = Str2Field(txtBPOAmt) !bill_date = Str2Field(txtBillDate) !bill_amt = Str2Field(txtBillAmt) !Owner_Name = Str2Field(txtHName) !Owner_address = Str2Field(txtHAddress) !Owner_phone = Str2Field(txtHPhone) !VWP_Super = Str2Field(txtVWPSuper) !storys = Str2Field(txtStory) !est_time = Str2Field(txtEstTime) !bc_who = Str2Field(txtBCWho) !Desc = Str2Field(txtDesc) !crewsize = Str2Field(txtWorkers) !notes = Str2Field(txtNotes) !sequence = Str2Field(txtSeq) !Area = Left((cboDArea.Text), 1) !billed = chkBilled !punch = chkPunch !yrend1 = chkYr1 !yrend2 = chkYr2 !wo = chkWO !repair = chkWarrenty !backcharge = chkBC !repair_crew = (cboRCrew.ListIndex + 1) !UpdateUser = gstrLOGIN !Updated = Date !proj_lot = lblProjectLot.Caption !Proj_ID = gintPROJID End With moRSRepair.Update If mboolAdding Then Call RepairLoad ' Call PlanMatLoad ' Call POptLoad If FormFind() Then Call FormShow 'xxxxxxxxxxxxxxxxxx Else Call FormClear End If End If Exit Sub Error_EH: If Err.Number = -2147467259 Then ' MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" ' strLOT = InputBox("Enter a New Lot Number", "Fix Duplicate") ' If Len(strLOT) > 0 Then ' moRS!lot_no = Field2Str(strLOT) ' moRS.Update ' txtLotNo = Field2Str(strLOT) ' End If Resume Next End If gstrMODULE = "Form Repair - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() txtScheduled = "" txtBContact = "" txtBPhone = "" txtBPO = "" txtBPOAmt = 0 txtBillDate = "" txtBillAmt = 0 txtHName = "" txtHAddress = "" txtHPhone = "" txtVWPSuper = "" txtBCWho = "" txtDesc = "" txtNotes = "" cboDArea.ListIndex = -1 chkBilled = vbUnchecked chkWO = vbUnchecked chkWarrenty = vbUnchecked chkBC = vbUnchecked cboRCrew.ListIndex = -1 lblProjectLot = "" End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH ' If mboolAdding Then ' moRSRepair.AddNew ' moRSRepair!proj_id = gintPROJID ' moRSRepair!lot_id = gintLOTID ' moRSRepair!proj_lot = mstrPROJLOT ' End If ' Store the controls to the recordset Call FieldsSave moRSRepair.Update If mboolAdding Then mboolAdding = False End If Call RepairLoad Exit Sub Error_EH: Call ErrorHandler(moRSRepair.ActiveConnection) Exit Sub End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If moRSRepair.State = adStateOpen Then moRSRepair.Close End If End Sub Private Sub lstLot_DblClick() Dim lngPOS As Long, strSQL As String Dim oRS As Recordset lngPOS = InStr(1, lstLot.Text, vbTab, 1) gintLOTID = lstLot.ItemData(lstLot.ListIndex) mstrPROJLOT = mstrPROJLOT & " - " & Left(lstLot.Text, lngPOS - 1) lblProjectLot = mstrPROJLOT strSQL = "SELECT owner, address, lot_id FROM tblLotInfo WHERE lot_id = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' moRS.MovePrevious txtHName = Field2Str(oRS!Owner) txtHAddress = Field2Str(oRS!address) lstLot.Visible = False End Sub Private Sub lstProject_DblClick() gintPROJID = lstProject.ItemData(lstProject.ListIndex) mstrPROJLOT = lstProject.Text lstProject.Visible = False Call LotSelect lstLot.SetFocus End Sub Private Sub lstRepair_Click() On Error GoTo Error_EH If lstRepair.ListIndex <> -1 Then mlngREPAIRID = lstRepair.ItemData(lstRepair.ListIndex) If FormFind() Then Call FormShow Else Call FormClear End If End If Exit Sub Error_EH: gstrMODULE = "Form Repair - Module lstRepair_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstRepair_DblClick() cmdAdd.Enabled = False cmdSave.Enabled = True End Sub Private Sub txtBContact_GotFocus() Call FieldSelect(txtBContact) End Sub Private Sub txtBContact_LostFocus() txtBContact = UCase(txtBContact) End Sub Private Sub txtBCWho_GotFocus() Call FieldSelect(txtBCWho) End Sub Private Sub txtBCWho_LostFocus() txtBCWho = UCase(txtBCWho) End Sub Private Sub txtBillAmt_GotFocus() Call FieldSelect(txtBillAmt) End Sub Private Sub txtBillDate_GotFocus() Call FieldSelect(txtBillDate) End Sub Private Sub txtBillDate_LostFocus() Dim lngPOS As Long lngPOS = InStr(1, txtBillDate, "/", 1) If lngPOS = 0 Then If Len(txtBillDate) > 0 Then txtBillDate = Format(txtBillDate, "00/00/####") If Not IsDate(txtBillDate) Then MsgBox "The Date You Entered is not Valid - ReEnter" txtBillDate.SetFocus End If End If Else MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter" txtBillDate.SetFocus End If End Sub Private Sub txtBPhone_GotFocus() Call FieldSelect(txtBPhone) End Sub Private Sub txtBPO_GotFocus() Call FieldSelect(txtBPO) End Sub Private Sub txtBPOAmt_GotFocus() Call FieldSelect(txtBPOAmt) End Sub Private Sub txtCompleted_GotFocus() Call FieldSelect(txtCompleted) End Sub Private Sub txtCompleted_LostFocus() Dim lngPOS As Long lngPOS = InStr(1, txtCompleted, "/", 1) If lngPOS = 0 Then If Len(txtCompleted) > 0 Then txtCompleted = Format(txtCompleted, "00/00/####") If Not IsDate(txtCompleted) Then MsgBox "The Date You Entered is not Valid - ReEnter" txtCompleted.SetFocus End If End If Else MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter" txtCompleted.SetFocus End If End Sub Private Sub txtDesc_GotFocus() ' Call FieldSelect(txtDesc) End Sub Private Sub txtDesc_LostFocus() txtDesc = UCase(txtDesc) End Sub Private Sub txtEstTime_GotFocus() Call FieldSelect(txtEstTime) End Sub Private Sub txtHAddress_GotFocus() Call FieldSelect(txtHAddress) End Sub Private Sub txtHAddress_LostFocus() txtHAddress = UCase(txtHAddress) End Sub Private Sub txtHName_GotFocus() Call FieldSelect(txtHName) End Sub Private Sub txtHName_LostFocus() txtHName = UCase(txtHName) End Sub Private Sub txtHPhone_GotFocus() Call FieldSelect(txtHPhone) End Sub Private Sub txtNotes_GotFocus() ' txtNotes.MaxLength = Len(txtNotes) ' Call FieldSelect(txtNotes) End Sub Private Sub txtNotes_LostFocus() txtNotes = UCase(txtNotes) End Sub Private Sub txtScheduled_GotFocus() Call FieldSelect(txtScheduled) End Sub Private Sub txtScheduled_LostFocus() Dim lngPOS As Long lngPOS = InStr(1, txtScheduled, "/", 1) If lngPOS = 0 Then If Len(txtScheduled) > 0 Then txtScheduled = Format(txtScheduled, "00/00/####") If Not IsDate(txtScheduled) Then MsgBox "The Date You Entered is not Valid - ReEnter" txtScheduled.SetFocus End If End If Else If Not IsDate(txtScheduled) Then MsgBox "The Date You Entered is not Valid - ReEnter" txtScheduled.SetFocus Else Exit Sub End If End If End Sub Private Sub txtStory_GotFocus() Call FieldSelect(txtStory) End Sub Private Sub txtVWPSuper_GotFocus() Call FieldSelect(txtVWPSuper) End Sub Private Sub txtVWPSuper_LostFocus() txtVWPSuper = UCase(txtVWPSuper) End Sub Private Sub GetLotInfo() Dim strSQL As String, strSELECT As String strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic If Not moRS.EOF Then strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Long(moRS!Proj_ID) ' strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Integer(moRS!proj_id) Set moRSProj = New Recordset moRSProj.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic End If gintPROJID = moRSProj!Proj_ID mstrPROJLOT = Trim(Field2Str(moRSProj!Proj_Desc)) & " - " & Trim(Field2Str(moRS!lot_no)) lblProjectLot = mstrPROJLOT End Sub Private Sub LotSelect() Dim strSQL As String, strLine As String On Error GoTo Error_EH strSQL = "SELECT Lot_no, address, owner, lot_id FROM tblLotInfo WHERE proj_id = " & gintPROJID Set moRS = New Recordset moRS.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly lstLot.Visible = True lstLot.Clear Do Until moRS.EOF strLine = "" strLine = Field2Str(moRS!lot_no) & vbTab & Field2Str(moRS!address) lstLot.AddItem strLine lstLot.ItemData(lstLot.NewIndex) = Field2Long(moRS!Lot_id) moRS.MoveNext Loop ' cboRCrew.ListIndex = 0 Exit Sub Error_EH: gstrMODULE = "Form Repair - Module LotSelect" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ProjectSelect() Dim oRS As Recordset Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT Proj_id, Proj_Desc FROM tblProject" Set oRS = New Recordset oRS.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly lstProject.Visible = True lstProject.Clear Do Until oRS.EOF lstProject.AddItem oRS!Proj_Desc lstProject.ItemData(lstProject.NewIndex) = Field2Long(oRS!Proj_ID) oRS.MoveNext Loop oRS.Close Exit Sub Error_EH: gstrMODULE = "Form Repair - Module ProjectSelect" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub 'Public Sub LotChange(strProjLot As String, strAction As String) ' ' Load frmChange ' frmChange.lblProjLot = strProjLot ' frmChange.lblAction = strAction ' ' frmChange.Show 1 ' 'End Sub