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" Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmJCList Caption = "Job Cost List" ClientHeight = 6870 ClientLeft = 60 ClientTop = 345 ClientWidth = 9000 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 6870 ScaleWidth = 9000 StartUpPosition = 3 'Windows Default Begin LpLib.fpList lstLots Height = 5220 Left = 90 TabIndex = 22 Top = 1440 Width = 5595 _Version = 196608 _ExtentX = 9869 _ExtentY = 9208 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = -2147483643 ForeColor = -2147483640 Columns = 4 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = 270 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 300 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmJCList.frx":0000 End Begin VB.CommandButton cmdFindLathDate Caption = "Find By Project && Lath Date" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 5820 TabIndex = 21 Top = 4800 Width = 1515 End Begin VB.CommandButton cmdProcess2 Caption = "Calc Project JC && Print" 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 = 7380 TabIndex = 17 Top = 5715 Width = 1515 End Begin VB.CommandButton cmdTest2 Caption = "Import AR" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 450 Left = 6580 TabIndex = 1 Top = 5700 Visible = 0 'False Width = 755 End Begin VB.CommandButton cmdTest Caption = "Import AP" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 450 Left = 5820 TabIndex = 2 Top = 5700 Visible = 0 'False Width = 720 End Begin VB.TextBox txtProjCode Height = 315 Left = 7440 TabIndex = 14 Top = 2340 Width = 1455 End Begin VB.CommandButton cmdFindProj Caption = "Find by Project && Texture Date " BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 5820 TabIndex = 15 Top = 3900 Width = 1515 End Begin MSComCtl2.DTPicker dtpEDate Height = 315 Left = 7440 TabIndex = 13 Top = 1860 Width = 1515 _ExtentX = 2672 _ExtentY = 556 _Version = 393216 Format = 92864513 CurrentDate = 37413 End Begin MSComCtl2.DTPicker dtpBDate Height = 315 Left = 7440 TabIndex = 12 Top = 1500 Width = 1515 _ExtentX = 2672 _ExtentY = 556 _Version = 393216 Format = 92864513 CurrentDate = 37413 End Begin VB.CommandButton cmdProcess Caption = "Calculate Lot JC && Print" 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 = 7380 TabIndex = 16 Top = 5100 Width = 1515 End Begin VB.CommandButton cmdDelete Caption = "Delete 1 Lot" 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 = 7380 TabIndex = 11 Top = 4560 Width = 1515 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 = 495 Left = 7380 TabIndex = 10 Top = 6315 Width = 1515 End Begin VB.CommandButton cmdFlush Caption = "&Flush List" 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 = 7380 TabIndex = 9 Top = 3960 Width = 1515 End Begin VB.CommandButton cmdSelectAll Caption = "&Select All" 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 = 7380 TabIndex = 8 Top = 3360 Width = 1515 End Begin VB.CommandButton cmdFind Caption = "Find Lots by Date All Project" 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 = 5820 TabIndex = 7 Top = 3360 Visible = 0 'False Width = 1515 End Begin VB.ListBox lstLots2 Height = 1425 Left = 60 TabIndex = 6 Top = 5325 Visible = 0 'False Width = 5535 End Begin VB.CheckBox chkSelect Alignment = 1 'Right Justify BackColor = &H0000FFFF& Caption = "Selected for Job Cost Run:" 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 ForeColor = &H000000FF& Height = 255 Left = 5700 TabIndex = 5 Top = 2940 Width = 3195 End Begin Crystal.CrystalReport crJobCost Left = 8520 Top = 900 _ExtentX = 741 _ExtentY = 741 _Version = 348160 PrintFileLinesPerPage= 60 End Begin VB.Label lblBegTime Caption = " " Height = 285 Left = 5820 TabIndex = 20 Top = 6240 Width = 1335 End Begin VB.Label lblEndTime Caption = " " Height = 285 Left = 5820 TabIndex = 19 Top = 6570 Width = 1335 End Begin VB.Label lblProject Alignment = 1 'Right Justify Caption = "Enter the Desired Project Code to Find" Height = 435 Left = 5700 TabIndex = 18 Top = 2280 Width = 1635 End Begin VB.Label lblEndDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Ending Date:" Height = 195 Left = 6405 TabIndex = 4 Top = 1920 Width = 930 End Begin VB.Label lblBegDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Beginning Date:" Height = 195 Left = 6180 TabIndex = 3 Top = 1560 Width = 1140 End Begin VB.Label lblInstructions Caption = $"frmJCList.frx":03C2 BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1275 Left = 60 TabIndex = 0 Top = 60 Width = 8895 WordWrap = -1 'True End End Attribute VB_Name = "frmJCList" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSJC As Recordset, moRS As Recordset Dim mboolSHOW As Boolean, mboolAdding As Boolean, mintSQYDS As Integer, mintMETAL As Integer Dim mlngORDERID As Long, mintBOOKMARK As Integer, mstrRTYPE As String Dim mstrPROJLOT As String, mboolPRINT As Boolean, mboolWINDOW As Boolean Dim mboolREPORT, mstrWDone As String, mstrWTYPE As String Private Sub BuildList() Dim oRS As Recordset, oRP As Recordset, oRJ As Recordset Dim strSQL As String, strSql2 As String, strSQL3 As String Dim strLOT As String, intPROJ As Integer On Error GoTo Error_EH strSQL3 = "SELECT * FROM tblJCList" Set oRJ = New Recordset oRJ.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic ' intPROJ = InputBox("Enter the Project Number Desired", "Select Project", 0) ' strSQL = "SELECT * FROM tblLotInfo WHERE sorder >= #" & CDate(dtpBDate.Value) _ ' & "# and sorder <= #" & CDate(dtpEDate.Value) & "# and proj_id = " & intPROJ strSQL = "SELECT * FROM tblLotInfo WHERE sorder >= #" & CDate(dtpBDate.Value) _ & "# and sorder <= #" & CDate(dtpEDate.Value) & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF strSql2 = "SELECT * FROM tblProject WHERE proj_id = " & Field2Str(oRS!PROJ_ID) Set oRP = New Recordset oRP.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly strLOT = Field2Str(oRS!lot_no) If IsNumeric(strLOT) Then mstrPROJLOT = "Lot " & Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) Else mstrPROJLOT = Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) End If oRJ.AddNew oRJ!Lot_id = Field2Str(oRS!Lot_id) oRJ!PROJ_ID = Field2Str(oRP!PROJ_ID) oRJ!proj_lot = mstrPROJLOT oRJ!SORDER = Field2Str(oRS!SORDER) oRJ.Update oRS.MoveNext Loop If oRS.State = adStateOpen Then oRS.Close End If Exit Sub Error_EH: gstrMODULE = "Form JCList - Module BuildList" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub BuildList2() Dim oRS As Recordset, oRP As Recordset, oRJ As Recordset Dim strSQL As String, strSql2 As String, strSQL3 As String Dim strLOT As String, lngPROJ As Long On Error GoTo Error_EH strSQL3 = "SELECT * FROM tblJCList" Set oRJ = New Recordset oRJ.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblProject WHERE proj_code = " & """" & UCase(txtProjCode) & """" Set oRP = New Recordset oRP.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly lngPROJ = Field2Str2(oRP!PROJ_ID) ' intPROJ = InputBox("Enter the Project Number Desired", "Select Project", 0) strSQL = "SELECT * FROM tblLotInfo WHERE sorder >= #" & CDate(dtpBDate.Value) _ & "# and sorder <= #" & CDate(dtpEDate.Value) & "# and proj_id = " & lngPROJ ' strSQL = "SELECT * FROM tblLotInfo WHERE Proj_ID = " & lngPROJ Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF ' strSql2 = "SELECT * FROM tblProject WHERE proj_id = " & Field2Str(oRS!proj_id) ' Set oRP = New Recordset ' oRP.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly strLOT = Field2Str(oRS!lot_no) If IsNumeric(strLOT) Then mstrPROJLOT = "Lot " & Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) Else mstrPROJLOT = Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) End If oRJ.AddNew oRJ!Lot_id = Field2Str(oRS!Lot_id) oRJ!PROJ_ID = lngPROJ ' oRJ!proj_id = Field2Str(oRP!proj_id) oRJ!proj_lot = mstrPROJLOT oRJ!SORDER = Field2Str2(oRS!SORDER) oRJ.Update oRS.MoveNext Loop If oRS.State = adStateOpen Then oRS.Close End If Exit Sub Error_EH: gstrMODULE = "Form JCList - Module BuildList2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub BuildList3() Dim oRS As Recordset, oRP As Recordset, oRJ As Recordset Dim strSQL As String, strSql2 As String, strSQL3 As String Dim strLOT As String, lngPROJ As Long On Error GoTo Error_EH strSQL3 = "SELECT * FROM tblJCList" Set oRJ = New Recordset oRJ.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblProject WHERE proj_code = " & """" & UCase(txtProjCode) & """" Set oRP = New Recordset oRP.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly lngPROJ = Field2Str2(oRP!PROJ_ID) ' intPROJ = InputBox("Enter the Project Number Desired", "Select Project", 0) strSQL = "SELECT * FROM tblLotInfo WHERE Lorder >= #" & CDate(dtpBDate.Value) _ & "# and Lorder <= #" & CDate(dtpEDate.Value) & "# and proj_id = " & lngPROJ ' strSQL = "SELECT * FROM tblLotInfo WHERE Proj_ID = " & lngPROJ Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF ' strSql2 = "SELECT * FROM tblProject WHERE proj_id = " & Field2Str(oRS!proj_id) ' Set oRP = New Recordset ' oRP.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly strLOT = Field2Str(oRS!lot_no) If IsNumeric(strLOT) Then mstrPROJLOT = "Lot " & Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) Else mstrPROJLOT = Field2Str(oRS!lot_no) & " - " & Field2Str(oRP!Proj_Desc) End If oRJ.AddNew oRJ!Lot_id = Field2Str(oRS!Lot_id) oRJ!PROJ_ID = lngPROJ ' oRJ!proj_id = Field2Str(oRP!proj_id) oRJ!proj_lot = mstrPROJLOT oRJ!SORDER = (oRS!SORDER) oRJ!lorder = Field2Str2(oRS!lorder) oRJ.Update oRS.MoveNext Loop If oRS.State = adStateOpen Then oRS.Close End If Exit Sub Error_EH: gstrMODULE = "Form JCList - Module BuildList3" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub LotLoad() Dim oRS As Recordset Dim strSQL As String, strCREW As String Dim strLine As String, strYN As String Dim lngRET As Long, aTabs(1) As Long On Error GoTo Error_EH ' aTabs(0) = 25 ' aTabs(1) = 70 ' aTabs(2) = 200 strSQL = "SELECT * from tblJClist ORDER by Lot_id" 'WHERE crew_id = " & Field2Str(lblCrewId.Caption) & " ORDER BY emp_id" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lngRET = SendMessage(lstLots.hwnd, LB_SETTABSTOPS, 2, aTabs(0)) lstLots.Clear Do Until oRS.EOF With lstLots If oRS!Selected Then strYN = "YES" Else strYN = "NO" End If strLine = strYN & vbTab & Field2Str(oRS!lorder) & vbTab & Field2Str(oRS!SORDER) & vbTab & Field2Str(oRS!proj_lot) '& vbTab & Field2Str(ors!empname) .AddItem strLine .ItemData(.NewIndex) = oRS!JCid End With oRS.MoveNext Loop oRS.Close If lstLots.ListCount Then lstLots.ListIndex = 0 cmdDelete.Enabled = True Else lstLots.ListIndex = -1 cmdDelete.Enabled = False End If Exit Sub Error_EH: gstrMODULE = "Form JCList - Module LotLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() ' dtpBDate.Value = "" ' dtpEDate.Value = "" chkSelect = vbUnchecked 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 tblJCList " strSQL = strSQL & "WHERE JCID = " & lstLots.ItemData(lstLots.ListIndex) ' strSQL = strSQL & "WHERE JCID = " & mlngORDERID Set moRSJC = New Recordset moRSJC.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRSJC.EOF Then FormFind = False Else FormFind = True ' gintLOTID = Field2Str2(moRSJC!lot_id) End If Exit Function Error_EH: gstrMODULE = "Form JCList - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FormShow() Dim mstrAREA As String Dim strSQL As String On Error GoTo Error_EH mboolSHOW = True ' strSQL = "Select * FROM tblLotInfo WHERE Lot_id = " & gintLOTID ' Set moRS = New Recordset ' moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' gintPROJID = Field2Str2(moRS!proj_id) ' strSQL = "Select * FROM tblProject WHERE proj_id = " & gintPROJID ' Set moRSProj = New Recordset ' moRSProj.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' lblProjLot.Caption = Trim(Field2Str(moRSProj!proj_desc)) & " " & Field2Str(moRS!lot_no) With moRSJC chkSelect = Field2CheckBox(!Selected) End With ' Call GetLotInfo mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form JCList - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdDelete_Click() Dim strSQL As String mintBOOKMARK = lstLots.ListIndex strSQL = "DELETE * FROM tblJCLIST WHERE JCID = " & lstLots.ItemData(lstLots.ListIndex) goConn.Execute strSQL Call LotLoad If mintBOOKMARK > (lstLots.ListCount - 1) Then lstLots.ListIndex = mintBOOKMARK - 1 Else lstLots.ListIndex = mintBOOKMARK End If End Sub Private Sub cmdFind_Click() frmJCList.MousePointer = vbHourglass Call BuildList Call LotLoad frmJCList.MousePointer = vbDefault End Sub Private Sub cmdFindLathDate_Click() Dim intYN intYN = MsgBox("Have you entered a Project Code Yet???", vbYesNo, "Project Code") If intYN = vbNo Then Exit Sub End If frmJCList.MousePointer = vbHourglass Call BuildList3 Call LotLoad frmJCList.MousePointer = vbDefault End Sub Private Sub cmdFindProj_Click() Dim intYN intYN = MsgBox("Have you entered a Project Code Yet???", vbYesNo, "Project Code") If intYN = vbNo Then Exit Sub End If frmJCList.MousePointer = vbHourglass Call BuildList2 Call LotLoad frmJCList.MousePointer = vbDefault End Sub Private Sub cmdFlush_Click() Dim strSQL As String If lstLots.ListCount = 0 Then Exit Sub End If strSQL = "DELETE * FROM tblJCLIST" goConn.Execute strSQL Call LotLoad End Sub Private Sub cmdProcess_Click() Dim oRS As Recordset, strYN As String Dim strSQL As String On Error GoTo Error_EH strYN = MsgBox("Do You Want To Print Report", vbYesNo, "Print?") If strYN = vbYes Then mboolREPORT = True mboolWINDOW = False Else mboolWINDOW = True mboolREPORT = False End If frmJCList.MousePointer = vbHourglass Call ToggleButtons strSQL = "SELECT * FROM tblJCList WHERE selected" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF gintLOTID = Field2Str(oRS!Lot_id) gintPROJID = Field2Str(oRS!PROJ_ID) Call CalcJobCost ' If mboolREPORT Then Call JCPrint ' End If oRS.MoveNext Loop Call ToggleButtons MsgBox "Job Cost Report Processing is Complete", vbOKOnly, "Job Cost Reports" frmJCList.MousePointer = vbDefault Exit Sub Error_EH: gstrMODULE = "Form JCList - Module cmdProcess_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdProcess2_Click() Dim oRS As Recordset, strYN As String Dim strSQL As String On Error GoTo Error_EH strYN = MsgBox("Do You Want To Print Report", vbYesNo, "Print?") If strYN = vbYes Then mboolREPORT = True mboolWINDOW = False Else mboolWINDOW = True mboolREPORT = False End If frmJCList.MousePointer = vbHourglass Call ToggleButtons strSQL = "SELECT * FROM tblJCList WHERE selected" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF gintLOTID = Field2Str(oRS!Lot_id) gintPROJID = Field2Str(oRS!PROJ_ID) Call CalcJobCost2 oRS.MoveNext Loop Call JCPrint2 Call ToggleButtons MsgBox "Job Cost Report Processing is Complete", vbOKOnly, "Job Cost Reports" frmJCList.MousePointer = vbDefault Exit Sub Error_EH: gstrMODULE = "Form JCList - Module cmdProcess2_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSelectAll_Click() Dim oRS As Recordset Dim strSQL As String If lstLots.ListCount = 0 Then Exit Sub End If strSQL = "SELECT * FROM tblJCList" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF oRS!Selected = vbChecked oRS.Update oRS.MoveNext Loop Call LotLoad End Sub Private Sub cmdTest_Click() Dim strSQL As String ' strSQL = "DELETE * FROM APH_JobDistDetail" ' WHERE Lot_id = " & gintLOTID ' goConn.Execute strSQL lblBegTime = "" lblEndTime = "" lblBegTime = Time DoEvents '' Call LoadMAS1 ' lblEndTime = Time ' DoEvents End Sub Private Sub cmdTest2_Click() Dim strSQL As String ' strSQL = "DELETE * FROM ARN_InvHistoryHeader" ' WHERE Lot_id = " & gintLOTID ' goConn.Execute strSQL lblBegTime = "" lblEndTime = "" lblBegTime = Time DoEvents '' Call LoadMAS2 End Sub Private Sub dtpBDate_Change() If dtpBDate.Value > dtpEDate.Value Then dtpEDate.Value = dtpBDate.Value End If End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If Shift = 4 Then Exit Sub 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 If gstrLOGIN = "DWW" Then ' cmdTest.Visible = True ' cmdTest2.Visible = True End If mboolREPORT = vbFalse ' Set morsjc = New Recordset dtpBDate.Value = Date dtpEDate.Value = Date Call LotLoad ' Call SupplierLoad Exit Sub Error_EH: gstrMODULE = "Form JCList - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstLots_Click() On Error GoTo Error_EH If lstLots.ListIndex <> -1 Then ' mlngORDERID = lstLots.ItemData(lstLots.ListIndex) If FormFind() Then Call FormShow Else Call FormClear End If End If Exit Sub Error_EH: gstrMODULE = "Form JCList - Module lstLots_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstLots_DblClick() mintBOOKMARK = lstLots.ListIndex ' If moRSJC!Selected = vbUnchecked Then moRSJC!Selected = vbChecked ' Else ' moRSJC!Selected = vbUnchecked ' End If moRSJC.Update Call LotLoad lstLots.ListIndex = mintBOOKMARK End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub GetWorkType() Dim strSQL As String, oRSW As Recordset strSQL = "SELECT * FROM tblcboWorkType WHERE WTCode = '" & mstrWDone & "'" Set oRSW = New Recordset oRSW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSW.EOF Then mstrWTYPE = Field2Str(oRSW!worktype) End If oRSW.Close End Sub Private Sub CalcJobCost() Dim oRS As Recordset, oRSC As Recordset, oRSD As Recordset, oRSF As Recordset, oRSS As Recordset Dim strSQL As String, strCALC As String, strSql2 As String, dblCALC As Double, strJC As String Dim intCALC As Integer, strJOBCOST As String, strREPORT As String, strFIND As String Dim strCont As String, strProj As String, strPROJCODE As String, strLOTNO As String Dim strMODEL As String, strADD As String, strOWNER As String, dblPO As Double Dim intYDS As Integer, intMETAL As Integer, strWORK As String, intCNT As Long '***************** need to add a calculation for total purchase orders and then calc the difference between '***************** AP and PO and add it to the cost of the project/lot. On Error GoTo Error_EH ' Call ToggleButtons1 strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRS.EOF Then MsgBox "No Lot Was Found, Try Again", vbOKOnly, "Select Lot" Exit Sub Else If IsNull(moRS!jobcost) Or moRS!jobcost = "" Then MsgBox "There is No Job Cost Code For This Lot - Enter One", vbOKOnly, "Enter JobCost Code" Exit Sub Else strCALC = "SELECT * FROM tblproject WHERE proj_id = " & Field2Long(moRS!PROJ_ID) Set oRSC = New Recordset oRSC.Open strCALC, goConn, adOpenForwardOnly, adLockReadOnly strJOBCOST = Field2Str(moRS!jobcost) strMODEL = Field2Str(moRS!model) strADD = Field2Str(moRS!address) strOWNER = Field2Str(moRS!Owner) strLOTNO = Field2Str(moRS!lot_no) strCont = Field2Str(oRSC!Proj_Cont) strProj = Field2Str(oRSC!Proj_Desc) strPROJCODE = Field2Str(oRSC!Proj_Code) intYDS = Field2Integer(moRS!sq_yd) intMETAL = Field2Integer(moRS!METAL) End If End If strSQL = "DELETE * FROM tblJobCost WHERE lot_id = " & gintLOTID goConn.Execute strSQL strSQL = "DELETE * FROM tblJobCost_Rpt WHERE lot_id = " & gintLOTID goConn.Execute strSQL strSQL = "SELECT * FROM tbljobcost WHERE lot_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strREPORT = "SELECT * FROM tblJobCost_Rpt where Lot_id = 1" Set oRSD = New Recordset oRSD.Open strREPORT, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT sum(orderamt) as SUMPO FROM tblORDERS WHERE D_Flag <> 'X' AND lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Purchase Order Information For This Lot", vbOKOnly, "No Purchase Orders" Else dblPO = Field2Str2(oRSC!sumpo) ' dblCALC = Field2Str2(oRSC!sumpo) strCALC = "TOTAL PO's ISSUED" intCALC = 1 ' moRS!pr = dblCALC ' moRS.Update ' GoSub Save_Info End If strSql2 = "SELECT * FROM tblORDERS WHERE D_Flag <> 'X' AND lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic intCNT = oRSC.RecordCount Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 1 oRSD!desc1 = Field2Str(!po_num) oRSD!desc2 = Field2Str2(!supplier) If !d_flag = "Y" Then oRSD!desc3 = "Yard" Else oRSD!desc3 = "Supplier" End If If !m_type = "L" Then oRSD!desc4 = "Lath" ElseIf !m_type = "P" Then oRSD!desc4 = "PreOrder" ElseIf !m_type = "R" Then oRSD!desc4 = "PO" ElseIf !m_type = "A" Then oRSD!desc4 = "Sand" ElseIf !m_type = "S" Then oRSD!desc4 = "Scratch" ElseIf !m_type = "B" Then oRSD!desc4 = "Brown" ElseIf !m_type = "T" Then oRSD!desc4 = "Texture" ElseIf !m_type = "W" Then oRSD!desc4 = "WRAP " ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" End If ' oRSD!date1 = Field2Str(!order_date) oRSD!date1 = !order_date ' oRSD!date1 = Field2Str2(!order_date) oRSD!amount1 = Field2Str2(!orderamt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(pay_amt) as SUMPAY FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payroll Information For This Lot", vbOKOnly, "No Payroll" Else dblCALC = Field2Str2(oRSC!sumpay) strCALC = "TOTAL PAYROLL" intCALC = 1 moRS!pr = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 4 If !pay_type = "S" Then oRSD!desc1 = "STUCCO" ElseIf !pay_type = "L" Then oRSD!desc1 = "LATH" ElseIf !pay_type = "C" Then oRSD!desc1 = "SCAFFOLD" ElseIf !pay_type = "Y" Then oRSD!desc1 = "SYNTHETIC" ElseIf !pay_type = "V" Then oRSD!desc1 = "STONE" ElseIf !pay_type = "X" Then oRSD!desc1 = "PAINT" End If strFIND = "SELECT crew_id, crew_boss FROM tblCREW WHERE crew_id = " & Field2Str2(!crew) Set oRSF = New Recordset oRSF.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSF.EOF Then oRSD!desc2 = Field2Str2(oRSF!Crew_Boss) Else oRSD!desc2 = "NO CREW FOUND" End If mstrWDone = Field2Str(!WorkDone) Call GetWorkType strWORK = mstrWTYPE oRSD!desc3 = Mid(strWORK, 1, 17) ' If !workdone = "C" Then ' oRSD!desc3 = "COMPLETE" ' ElseIf !workdone = "P" Then ' oRSD!desc3 = "PARTIAL" ' ElseIf !workdone = "T" Then ' oRSD!desc3 = "TEXTURE" ' ElseIf !workdone = "S" Then ' oRSD!desc3 = "SCRATCH" ' ElseIf !workdone = "B" Then ' oRSD!desc3 = "BROWN" ' ElseIf !workdone = "U" Then ' oRSD!desc3 = "CMU" ' ElseIf !workdone = "F" Then ' oRSD!desc3 = "FENCE" ' ElseIf !workdone = "W" Then ' oRSD!desc3 = "WORKORDER/REPAIR" ' ElseIf !workdone = "R" Then ' oRSD!desc3 = "REPAIR" ' ElseIf !workdone = "Y" Then ' oRSD!desc3 = "UP" ' ElseIf !workdone = "Z" Then ' oRSD!desc3 = "DOWN" ' End If oRSD!date1 = !prdate oRSD!desc4 = Field2Str2(!prcheck) oRSD!amount1 = Field2Str2(!pay_amt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSql2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payables Information For This Lot", vbOKOnly, "No Payables" Else dblCALC = Field2Str2(oRSC!sumap) strCALC = "TOTAL ACCOUNTS PAYABLE" intCALC = 1 moRS!ap = dblCALC ' moRS.Update GoSub Save_Info End If If dblPO > dblCALC Then dblCALC = dblPO - dblCALC strCALC = "TOTAL PO's ISSUES OVER AP" intCALC = 1 GoSub Save_Info End If strSql2 = "SELECT VendorNumber, JobNumber, InvoiceNumber, DistributionAmount FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 2 oRSD!desc1 = Field2Str(!VendorNumber) oRSD!desc2 = Field2Str2(!InvoiceNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!amount1 = Field2Str2(!distributionamount) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If '*** watch out for duplicate amounts strSql2 = "SELECT sum(TaxableSalesAmount+NonTaxableSalesAmount+SalesTaxAmount) as SUMBILL from ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Billing Information For This Lot", vbOKOnly, "No Billings" Else dblCALC = Field2Str2(oRSC!sumbill) strCALC = "TOTAL BILLINGS" intCALC = 0 moRS!bill = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT CustomerNumber, JobNumber, TaxableSalesAmount, NonTaxableSalesAmount, SalesTaxAmount, InvoiceNumber, InvoiceDate FROM ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 5 oRSD!desc1 = Field2Str(!InvoiceNumber) oRSD!desc2 = Field2Str2(!CustomerNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!date1 = Field2Str(!InvoiceDate) oRSD!amount1 = (CDec(Field2Str2(!TaxableSalesAmount)) + CDec(Field2Str2(!NonTaxableSalesAmount)) + CDec(Field2Str2(!SalesTaxAmount))) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(QtyIssue*Price) as SUMYARD FROM tblYardOrder WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Yard Order Information For This Lot", vbOKOnly, "No Yard Order" Else dblCALC = Field2Str2(oRSC!sumyard) strCALC = "TOTAL YARD ORDER" intCALC = 1 moRS!yard = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblYardORDER WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 3 oRSD!desc1 = Field2Str(!inv_no) oRSD!desc2 = Field2Str2(!Desc) oRSD!date1 = !issued ' oRSD!date1 = Field2Str2(!issued) oRSD!number1 = Field2Str2(!qtyIssue) oRSD!amount1 = Field2Str2(!price) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' MsgBox "Job Cost Summary Calculation is Complete", vbOKOnly, "JC Calculation" mboolPRINT = True strJC = "SELECT * FROM tblSYSInfo" Set oRSS = New Recordset oRSS.Open strJC, goConn, adOpenForwardOnly, adLockReadOnly moRS!id1 = Round((Field2Str2(oRSS!tax_wc) * Field2Str2(moRS!sq_yd)), 2) moRS!id2 = Round((Field2Str2(oRSS!scaf) * Field2Str2(moRS!sq_yd)), 2) moRS!id3 = Round((Field2Str2(oRSS!ind_job) * Field2Str2(moRS!sq_yd)), 2) moRS!id4 = Round((Field2Str2(oRSS!office) * Field2Str2(moRS!sq_yd)), 2) moRS!ga1 = Round((Field2Str2(oRSS!ga) * Field2Str2(moRS!sq_yd)), 2) moRS.Update moRS.Close oRSS.Close If oRS.State = adStateOpen Then oRS.Close Set oRS = Nothing End If If oRSF.State = adStateOpen Then oRSF.Close Set oRSF = Nothing End If If oRSD.State = adStateOpen Then oRSD.Close Set oRSD = Nothing End If If oRSC.State = adStateOpen Then oRSC.Close Set oRSC = Nothing End If Exit Sub Save_Info: oRS.AddNew oRS!Lot_id = gintLOTID oRS!calc_date = Date oRS!Amt = Field2Str2(dblCALC) oRS!Desc = Field2Str(strCALC) oRS!Type = intCALC oRS!Create = gstrLOGIN oRS.Update Return Error_EH: gstrMODULE = "Form JCList - Module CalcJobCost" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CalcJobCost2() Dim oRS As Recordset, oRSC As Recordset, oRSD As Recordset, oRSF As Recordset, oRSS As Recordset Dim strSQL As String, strCALC As String, strSql2 As String, dblCALC As Double, strJC As String Dim intCALC As Integer, strJOBCOST As String, strREPORT As String, strFIND As String Dim strCont As String, strProj As String, strPROJCODE As String, strLOTNO As String Dim strMODEL As String, strADD As String, strOWNER As String, dblPO As Double Dim intYDS As Integer, intMETAL As Integer, strWORK As String On Error GoTo Error_EH ' Call ToggleButtons1 strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRS.EOF Then MsgBox "No Lot Was Found, Try Again", vbOKOnly, "Select Lot" Exit Sub Else If IsNull(moRS!jobcost) Or moRS!jobcost = "" Then MsgBox "There is No Job Cost Code For This Lot - Enter One", vbOKOnly, "Enter JobCost Code" Exit Sub Else strCALC = "SELECT * FROM tblproject WHERE proj_id = " & Field2Long(moRS!PROJ_ID) Set oRSC = New Recordset oRSC.Open strCALC, goConn, adOpenForwardOnly, adLockReadOnly strJOBCOST = Field2Str(moRS!jobcost) strMODEL = Field2Str(moRS!model) strADD = Field2Str(moRS!address) strOWNER = Field2Str(moRS!Owner) strLOTNO = Field2Str(moRS!lot_no) strCont = Field2Str(oRSC!Proj_Cont) strProj = Field2Str(oRSC!Proj_Desc) strPROJCODE = Field2Str(oRSC!Proj_Code) intYDS = Field2Integer(moRS!sq_yd) intMETAL = Field2Integer(moRS!METAL) mintSQYDS = intYDS mintMETAL = intMETAL End If End If ' strSQL = "DELETE * FROM tblJobCost WHERE create = '" & gstrLOGIN & "'" ' strSQL = "DELETE * FROM tblJobCost WHERE proj_id = " & gintPROJID strSQL = "DELETE * FROM tblJobCost WHERE lot_id = " & gintLOTID goConn.Execute strSQL ' strSQL = "DELETE * FROM tblJobCost_Rpt WHERE create = '" & gstrLOGIN & "'" ' strSQL = "DELETE * FROM tblJobCost_Rpt WHERE proj_id = " & gintPROJID strSQL = "DELETE * FROM tblJobCost_Rpt WHERE lot_id = " & gintLOTID goConn.Execute strSQL strSQL = "SELECT * FROM tbljobcost WHERE lot_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strREPORT = "SELECT * FROM tblJobCost_Rpt where Lot_id = 1" Set oRSD = New Recordset oRSD.Open strREPORT, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT sum(orderamt) as SUMPO FROM tblORDERS WHERE D_Flag <> 'X' AND lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Purchase Order Information For This Lot", vbOKOnly, "No Purchase Orders" Else dblPO = Field2Str2(oRSC!sumpo) ' dblCALC = Field2Str2(oRSC!sumpo) strCALC = "TOTAL PO's ISSUED" intCALC = 1 ' moRS!pr = dblCALC ' moRS.Update ' GoSub Save_Info End If strSql2 = "SELECT * FROM tblORDERS WHERE D_Flag <> 'X' AND lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!PROJ_ID = gintPROJID oRSD!Type = 1 oRSD!desc1 = Field2Str(!po_num) oRSD!desc2 = Field2Str2(!supplier) If !d_flag = "Y" Then oRSD!desc3 = "Yard" Else oRSD!desc3 = "Supplier" End If If !m_type = "L" Then oRSD!desc4 = "Lath" ElseIf !m_type = "P" Then oRSD!desc4 = "PreOrder" ElseIf !m_type = "R" Then oRSD!desc4 = "PO" ElseIf !m_type = "A" Then oRSD!desc4 = "Sand" ElseIf !m_type = "S" Then oRSD!desc4 = "Scratch" ElseIf !m_type = "B" Then oRSD!desc4 = "Brown" ElseIf !m_type = "T" Then oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" End If ' oRSD!date1 = Field2Str(!order_date) oRSD!date1 = !order_date ' oRSD!date1 = Field2Str2(!order_date) oRSD!amount1 = Field2Str2(!orderamt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(pay_amt) as SUMPAY FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payroll Information For This Lot", vbOKOnly, "No Payroll" Else dblCALC = Field2Str2(oRSC!sumpay) strCALC = "TOTAL PAYROLL" intCALC = 1 mstrRTYPE = 3 moRS!pr = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!PROJ_ID = gintPROJID oRSD!Type = 4 ' mstrRTYPE = 3 If !pay_type = "S" Then oRSD!desc1 = "STUCCO" ElseIf !pay_type = "L" Then oRSD!desc1 = "LATH" ElseIf !pay_type = "C" Then oRSD!desc1 = "SCAFFOLD" ElseIf !pay_type = "Y" Then oRSD!desc1 = "SYNTHETIC" ElseIf !pay_type = "V" Then oRSD!desc1 = "STONE" ElseIf !pay_type = "X" Then oRSD!desc1 = "PAINT" End If strFIND = "SELECT crew_id, crew_boss FROM tblCREW WHERE crew_id = " & Field2Str2(!crew) Set oRSF = New Recordset oRSF.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSF.EOF Then oRSD!desc2 = Field2Str2(oRSF!Crew_Boss) Else oRSD!desc2 = "NO CREW FOUND" End If mstrWDone = Field2Str(!WorkDone) Call GetWorkType strWORK = mstrWTYPE oRSD!desc3 = Mid(strWORK, 1, 17) ' If !workdone = "C" Then ' oRSD!desc3 = "COMPLETE" ' ElseIf !workdone = "P" Then ' oRSD!desc3 = "PARTIAL" ' ElseIf !workdone = "T" Then ' oRSD!desc3 = "TEXTURE" ' ElseIf !workdone = "S" Then ' oRSD!desc3 = "SCRATCH" ' ElseIf !workdone = "B" Then ' oRSD!desc3 = "BROWN" ' ElseIf !workdone = "U" Then ' oRSD!desc3 = "CMU" ' ElseIf !workdone = "F" Then ' oRSD!desc3 = "FENCE" ' ElseIf !workdone = "W" Then ' oRSD!desc3 = "WORKORDER/REPAIR" ' ElseIf !workdone = "R" Then ' oRSD!desc3 = "REPAIR" ' ElseIf !workdone = "Y" Then ' oRSD!desc3 = "UP" ' ElseIf !workdone = "Z" Then ' oRSD!desc3 = "DOWN" ' End If oRSD!date1 = !prdate oRSD!desc4 = Field2Str2(!prcheck) oRSD!amount1 = Field2Str2(!pay_amt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSql2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payables Information For This Lot", vbOKOnly, "No Payables" Else dblCALC = Field2Str2(oRSC!sumap) strCALC = "TOTAL ACCOUNTS PAYABLE" intCALC = 1 mstrRTYPE = 4 moRS!ap = dblCALC ' moRS.Update GoSub Save_Info End If If dblPO > dblCALC Then dblCALC = dblPO - dblCALC strCALC = "TOTAL PO's ISSUES OVER AP" intCALC = 1 mstrRTYPE = 5 GoSub Save_Info End If strSql2 = "SELECT VendorNumber, JobNumber, InvoiceNumber, DistributionAmount FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!PROJ_ID = gintPROJID oRSD!Type = 2 ' mstrRTYPE = 4 oRSD!desc1 = Field2Str(!VendorNumber) oRSD!desc2 = Field2Str2(!InvoiceNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!amount1 = Field2Str2(!distributionamount) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSql2 = "SELECT sum(TaxableSalesAmount+NonTaxableSalesAmount+SalesTaxAmount) as SUMBILL from ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Billing Information For This Lot", vbOKOnly, "No Billings" Else dblCALC = Field2Str2(oRSC!sumbill) strCALC = "TOTAL BILLINGS" intCALC = 0 mstrRTYPE = 2 moRS!bill = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT CustomerNumber, JobNumber, TaxableSalesAmount, NonTaxableSalesAmount, SalesTaxAmount, InvoiceNumber, InvoiceDate FROM ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!PROJ_ID = gintPROJID oRSD!Type = 5 ' mstrRTYPE = 2 oRSD!desc1 = Field2Str(!InvoiceNumber) oRSD!desc2 = Field2Str2(!CustomerNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!date1 = Field2Str(!InvoiceDate) oRSD!amount1 = (CDec(Field2Str2(!TaxableSalesAmount)) + CDec(Field2Str2(!NonTaxableSalesAmount)) + CDec(Field2Str2(!SalesTaxAmount))) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(QtyIssue*Price) as SUMYARD FROM tblYardOrder WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Yard Order Information For This Lot", vbOKOnly, "No Yard Order" Else dblCALC = Field2Str2(oRSC!sumyard) strCALC = "TOTAL YARD ORDER" intCALC = 1 mstrRTYPE = 6 moRS!yard = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblYardORDER WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!PROJ_ID = gintPROJID oRSD!Type = 3 ' mstrRTYPE = 5 oRSD!desc1 = Field2Str(!inv_no) oRSD!desc2 = Field2Str(Mid(!Desc, 1, 30)) oRSD!date1 = !issued ' oRSD!date1 = Field2Str2(!issued) oRSD!number1 = Field2Str2(!qtyIssue) oRSD!amount1 = Field2Str2(!price) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' MsgBox "Job Cost Summary Calculation is Complete", vbOKOnly, "JC Calculation" mboolPRINT = True strJC = "SELECT * FROM tblSYSInfo" Set oRSS = New Recordset oRSS.Open strJC, goConn, adOpenForwardOnly, adLockReadOnly moRS!id1 = Round((Field2Str2(oRSS!tax_wc) * Field2Str2(moRS!sq_yd)), 2) moRS!id2 = Round((Field2Str2(oRSS!scaf) * Field2Str2(moRS!sq_yd)), 2) moRS!id3 = Round((Field2Str2(oRSS!ind_job) * Field2Str2(moRS!sq_yd)), 2) moRS!id4 = Round((Field2Str2(oRSS!office) * Field2Str2(moRS!sq_yd)), 2) moRS!ga1 = Round((Field2Str2(oRSS!ga) * Field2Str2(moRS!sq_yd)), 2) moRS.Update moRS.Close oRSS.Close If oRS.State = adStateOpen Then oRS.Close Set oRS = Nothing End If ' If oRSF.State = adStateOpen Then ' oRSF.Close ' Set oRSF = Nothing ' End If If oRSD.State = adStateOpen Then oRSD.Close Set oRSD = Nothing End If If oRSC.State = adStateOpen Then oRSC.Close Set oRSC = Nothing End If Exit Sub Save_Info: oRS.AddNew oRS!Lot_id = gintLOTID oRS!PROJ_ID = gintPROJID oRS!calc_date = Date oRS!Amt = Field2Str2(dblCALC) oRS!Desc = Field2Str(strCALC) oRS!Type = intCALC oRS!RType = mstrRTYPE oRS!Create = gstrLOGIN oRS!SQYDS = mintSQYDS oRS!METAL = mintMETAL oRS.Update Return Error_EH: gstrMODULE = "Form JCList - Module CalcJobCost2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CalcJobCostOld() Dim oRS As Recordset, oRSC As Recordset, oRSD As Recordset, oRSF As Recordset, oRSS As Recordset Dim strSQL As String, strCALC As String, strSql2 As String, dblCALC As Double, strJC As String Dim intCALC As Integer, strJOBCOST As String, strREPORT As String, strFIND As String Dim strCont As String, strProj As String, strPROJCODE As String, strLOTNO As String Dim strMODEL As String, strADD As String, strOWNER As String Dim intYDS As Integer, intMETAL As Integer, strWORK As String ' On Error GoTo Error_EH ' Call ToggleButtons1 strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRS.EOF Then MsgBox "No Lot Was Found, Try Again", vbOKOnly, "Select Lot" Exit Sub Else If IsNull(moRS!jobcost) Or moRS!jobcost = "" Then MsgBox "There is No Job Cost Code For This Lot - Enter One", vbOKOnly, "Enter JobCost Code" Exit Sub Else strCALC = "SELECT * FROM tblproject WHERE proj_id = " & Field2Long(moRS!PROJ_ID) Set oRSC = New Recordset oRSC.Open strCALC, goConn, adOpenForwardOnly, adLockReadOnly strJOBCOST = Field2Str(moRS!jobcost) strMODEL = Field2Str(moRS!model) strADD = Field2Str(moRS!address) strOWNER = Field2Str(moRS!Owner) strLOTNO = Field2Str(moRS!lot_no) strCont = Field2Str(oRSC!Proj_Cont) strProj = Field2Str(oRSC!Proj_Desc) strPROJCODE = Field2Str(oRSC!Proj_Code) intYDS = Field2Integer(moRS!sq_yd) intMETAL = Field2Integer(moRS!METAL) End If End If strSQL = "DELETE * FROM tblJobCost WHERE lot_id = " & gintLOTID goConn.Execute strSQL strSQL = "DELETE * FROM tblJobCost_Rpt WHERE lot_id = " & gintLOTID goConn.Execute strSQL strSQL = "SELECT * FROM tbljobcost WHERE lot_id = 1" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic strREPORT = "SELECT * FROM tblJobCost_Rpt where Lot_id = 1" Set oRSD = New Recordset oRSD.Open strREPORT, goConn, adOpenKeyset, adLockOptimistic strSql2 = "SELECT * FROM tblORDERS WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 1 oRSD!desc1 = Field2Str(!po_num) oRSD!desc2 = Field2Str2(!supplier) If !d_flag = "Y" Then oRSD!desc3 = "Yard" Else oRSD!desc3 = "Supplier" End If If !m_type = "L" Then oRSD!desc4 = "Lath" ElseIf !m_type = "P" Then oRSD!desc4 = "PreOrder" ElseIf !m_type = "R" Then oRSD!desc4 = "PO" ElseIf !m_type = "A" Then oRSD!desc4 = "Sand" ElseIf !m_type = "S" Then oRSD!desc4 = "Scratch" ElseIf !m_type = "B" Then oRSD!desc4 = "Brown" ElseIf !m_type = "T" Then oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" ' ElseIf !m_type = "T" Then ' oRSD!desc4 = "Texture" End If ' oRSD!date1 = Field2Str(!order_date) oRSD!date1 = !order_date ' oRSD!date1 = Field2Str2(!order_date) oRSD!amount1 = Field2Str2(!orderamt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(pay_amt) as SUMPAY FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payroll Information For This Lot", vbOKOnly, "No Payroll" Else dblCALC = Field2Str2(oRSC!sumpay) strCALC = "TOTAL PAYROLL" intCALC = 1 moRS!pr = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblTIME WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 4 If !pay_type = "S" Then oRSD!desc1 = "STUCCO" ElseIf !pay_type = "L" Then oRSD!desc1 = "LATH" ElseIf !pay_type = "C" Then oRSD!desc1 = "SCAFFOLD" ElseIf !pay_type = "Y" Then oRSD!desc1 = "SYNTHETIC" ElseIf !pay_type = "V" Then oRSD!desc1 = "STONE" ElseIf !pay_type = "X" Then oRSD!desc1 = "PAINT" End If strFIND = "SELECT crew_id, crew_boss FROM tblCREW WHERE crew_id = " & Field2Str2(!crew) Set oRSF = New Recordset oRSF.Open strFIND, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSF.EOF Then oRSD!desc2 = Field2Str2(oRSF!Crew_Boss) Else oRSD!desc2 = "NO CREW FOUND" End If mstrWDone = Field2Str(oRSD!WorkDone) Call GetWorkType strWORK = mstrWTYPE oRSD!desc3 = strWORK ' If !workdone = "C" Then ' oRSD!desc3 = "COMPLETE" ' ElseIf !workdone = "P" Then ' oRSD!desc3 = "PARTIAL" ' ElseIf !workdone = "T" Then ' oRSD!desc3 = "TEXTURE" ' ElseIf !workdone = "S" Then ' oRSD!desc3 = "SCRATCH" ' ElseIf !workdone = "B" Then ' oRSD!desc3 = "BROWN" ' ElseIf !workdone = "U" Then ' oRSD!desc3 = "CMU" ' ElseIf !workdone = "F" Then ' oRSD!desc3 = "FENCE" ' ElseIf !workdone = "W" Then ' oRSD!desc3 = "WORKORDER/REPAIR" ' ElseIf !workdone = "R" Then ' oRSD!desc3 = "REPAIR" ' ElseIf !workdone = "Y" Then ' oRSD!desc3 = "UP" ' ElseIf !workdone = "Z" Then ' oRSD!desc3 = "DOWN" ' End If oRSD!date1 = !prdate oRSD!desc4 = Field2Str2(!prcheck) oRSD!amount1 = Field2Str2(!pay_amt) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSql2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Payables Information For This Lot", vbOKOnly, "No Payables" Else dblCALC = Field2Str2(oRSC!sumap) strCALC = "TOTAL ACCOUNTS PAYABLE" intCALC = 1 moRS!ap = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT VendorNumber, JobNumber, InvoiceNumber, DistributionAmount FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 2 oRSD!desc1 = Field2Str(!VendorNumber) oRSD!desc2 = Field2Str2(!InvoiceNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!amount1 = Field2Str2(!distributionamount) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSql2 = "SELECT sum(TaxableSalesAmount+NonTaxableSalesAmount+SalesTaxAmount) as SUMBILL from ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Billing Information For This Lot", vbOKOnly, "No Billings" Else dblCALC = Field2Str2(oRSC!sumbill) strCALC = "TOTAL BILLINGS" intCALC = 0 moRS!bill = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT CustomerNumber, JobNumber, TaxableSalesAmount, NonTaxableSalesAmount, SalesTaxAmount, InvoiceNumber, InvoiceDate FROM ARN_invHistoryHeader WHERE JobNumber = '" & strJOBCOST & "'" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 5 oRSD!desc1 = Field2Str(!InvoiceNumber) oRSD!desc2 = Field2Str2(!CustomerNumber) oRSD!desc3 = Field2Str2(!JobNumber) oRSD!date1 = Field2Str(!InvoiceDate) oRSD!amount1 = (CDec(Field2Str2(!TaxableSalesAmount)) + CDec(Field2Str2(!NonTaxableSalesAmount)) + CDec(Field2Str2(!SalesTaxAmount))) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop strSql2 = "SELECT sum(QtyIssue*Price) as SUMYARD FROM tblYardOrder WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If oRSC.EOF Then MsgBox "No Yard Order Information For This Lot", vbOKOnly, "No Yard Order" Else dblCALC = Field2Str2(oRSC!sumyard) strCALC = "TOTAL YARD ORDER" intCALC = 1 moRS!yard = dblCALC ' moRS.Update GoSub Save_Info End If strSql2 = "SELECT * FROM tblYardORDER WHERE lot_id = " & gintLOTID Set oRSC = New Recordset oRSC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRSC.EOF With oRSC oRSD.AddNew oRSD!Lot_id = gintLOTID oRSD!Type = 3 oRSD!desc1 = Field2Str(!inv_no) oRSD!desc2 = Field2Str2(!Desc) oRSD!date1 = !issued ' oRSD!date1 = Field2Str2(!issued) oRSD!number1 = Field2Str2(!qtyIssue) oRSD!amount1 = Field2Str2(!price) oRSD!Create = gstrLOGIN oRSD!contr = strCont oRSD!project = strProj oRSD!projcode = strPROJCODE oRSD!lotno = strLOTNO oRSD!jc = strJOBCOST oRSD!model = strMODEL oRSD!address = strADD oRSD!Owner = strOWNER oRSD!SQYDS = intYDS oRSD!METAL = intMETAL oRSD.Update End With oRSC.MoveNext Loop ' MsgBox "Job Cost Summary Calculation is Complete", vbOKOnly, "JC Calculation" mboolPRINT = True strJC = "SELECT * FROM tblSYSInfo" Set oRSS = New Recordset oRSS.Open strJC, goConn, adOpenForwardOnly, adLockReadOnly moRS!id1 = Round((Field2Str2(oRSS!tax_wc) * Field2Str2(moRS!sq_yd)), 2) moRS!id2 = Round((Field2Str2(oRSS!scaf) * Field2Str2(moRS!sq_yd)), 2) moRS!id3 = Round((Field2Str2(oRSS!ind_job) * Field2Str2(moRS!sq_yd)), 2) moRS!id4 = Round((Field2Str2(oRSS!office) * Field2Str2(moRS!sq_yd)), 2) moRS!ga1 = Round((Field2Str2(oRSS!ga) * Field2Str2(moRS!sq_yd)), 2) moRS.Update moRS.Close oRSS.Close If oRS.State = adStateOpen Then oRS.Close Set oRS = Nothing End If If oRSF.State = adStateOpen Then oRSF.Close Set oRSF = Nothing End If If oRSD.State = adStateOpen Then oRSD.Close Set oRSD = Nothing End If If oRSC.State = adStateOpen Then oRSC.Close Set oRSC = Nothing End If Exit Sub Save_Info: oRS.AddNew oRS!Lot_id = gintLOTID oRS!calc_date = Date oRS!Amt = Field2Str2(dblCALC) oRS!Desc = Field2Str(strCALC) oRS!Type = intCALC oRS!Create = gstrLOGIN oRS.Update Return Error_EH: gstrMODULE = "Form JCList - Module CalcJobCost2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub LoadMAS1() Dim strSql2 As String, oRSC As Recordset Dim strSQL3 As String, oRSA As Recordset MsgBox "This Module Does Not Work. Contact Darv", vbOKOnly, "Does Not Work" Exit Sub ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If strSQL3 = "SELECT * FROM APH_JobDistDetail" Set oRSA = New Recordset oRSA.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic ' strSQL2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" strSql2 = "SELECT * FROM APH_JobDistDetail" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If Not oRSC.EOF Then Do Until oRSC.EOF oRSA.AddNew oRSA!Division = oRSC!Division oRSA!VendorNumber = oRSC!VendorNumber oRSA!InvoiceNumber = oRSC!InvoiceNumber oRSA!JobNumber = oRSC!JobNumber oRSA!CostCode = oRSC!CostCode oRSA!CostType = oRSC!CostType oRSA!distributionamount = oRSC!distributionamount oRSA!RetentionAmount = oRSC!RetentionAmount oRSA!Balance = oRSC!Balance oRSA!AmountAppliedToday = oRSC!AmountAppliedToday oRSA.Update oRSC.MoveNext Loop End If lblEndTime = Time DoEvents MsgBox "Job Distribution Detail Has Been Updated", vbOKOnly, "File Import" End Sub Private Sub LoadMAS2() Dim strSql2 As String, oRSC As Recordset Dim strSQL3 As String, oRSA As Recordset Dim strINV As String * 7, strSEQ As String, strCUTOFF As String Dim strSQL99 As String, oRS As Recordset, strINVDATE As String Dim dteINVDT As Date, strMSG As String, dteSTART As Date MsgBox "This Module Does Not Work. Contact Darv", vbOKOnly, "Does Not Work" Exit Sub ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If dteSTART = "01/01/2007" strSQL3 = "SELECT * FROM ARN_InvHistoryHeader" Set oRSA = New Recordset oRSA.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic ' strSQL2 = "SELECT sum(distributionAmount) as SUMAP FROM APH_JobDistDetail WHERE JobNumber = '" & strJOBCOST & "'" strSql2 = "SELECT * FROM ARN_InvHistoryHeader" ' WHERE invoicedate > '20080101'" Set oRSC = New Recordset oRSC.Open strSql2, goConn2, adOpenDynamic, adLockOptimistic If Not oRSC.EOF Then Do Until oRSC.EOF strINV = oRSC!InvoiceNumber strSEQ = oRSC!HeaderSeqNumber dteINVDT = Field2Str2(oRSC!InvoiceDate) If dteINVDT > dteSTART Then strSQL99 = "SELECT * FROM ARN_InvHistoryHeader WHERE InvoiceNumber = '" & strINV & "' AND SeqNumber = '" & strSEQ & "'" Set oRS = New Recordset oRS.Open strSQL99, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then Else oRSA.AddNew oRSA!CustomerNumber = oRSC!CustomerNumber oRSA!JobNumber = oRSC!JobNumber oRSA!InvoiceNumber = oRSC!InvoiceNumber oRSA!InvoiceDate = oRSC!InvoiceDate oRSA!TaxableSalesAmount = oRSC!TaxableSalesAmount oRSA!NonTaxableSalesAmount = oRSC!NonTaxableSalesAmount oRSA!SalesTaxAmount = oRSC!SalesTaxAmount oRSA!InvoiceType = oRSC!InvoiceType oRSA!seqnumber = oRSC!HeaderSeqNumber oRSA.Update End If End If oRSC.MoveNext Loop End If lblEndTime = Time DoEvents MsgBox "Invoice History Header Has Been Updated", vbOKOnly, "File Import" End Sub Private Sub JCPrint() Dim strSQL As String On Error GoTo Error_EH gintCOPY = 1 strSQL = "{tblJOBCOST_RPT.LOT_ID} = " & gintLOTID crJobCost.ReportFileName = App.Path & "\jobcost.rpt" crJobCost.SelectionFormula = strSQL crJobCost.CopiesToPrinter = gintCOPY If mboolWINDOW = True Then crJobCost.Destination = crptToWindow End If If mboolREPORT = True Then crJobCost.Destination = crptToPrinter End If crJobCost.Action = 1 crJobCost.Reset strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID crJobCost.ReportFileName = App.Path & "\jobcost2.rpt" crJobCost.SelectionFormula = strSQL crJobCost.CopiesToPrinter = gintCOPY If mboolWINDOW = True Then crJobCost.Destination = crptToWindow End If If mboolREPORT = True Then crJobCost.Destination = crptToPrinter End If crJobCost.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form JCList - Module JCPrint" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub JCPrint2() Dim strSQL As String On Error GoTo Error_EH gintCOPY = 1 strSQL = "{tblJOBCOST_RPT.PROJ_ID} = " & gintPROJID ' strSQL = "{tblJOBCOST_RPT.LOT_ID} = " & gintLOTID crJobCost.ReportFileName = App.Path & "\jobcostProj.rpt" crJobCost.SelectionFormula = strSQL crJobCost.CopiesToPrinter = gintCOPY If mboolWINDOW = True Then crJobCost.Destination = crptToWindow End If If mboolREPORT = True Then crJobCost.Destination = crptToPrinter End If crJobCost.Action = 1 crJobCost.Reset strSQL = "{tblLOTINFO.Proj_id} = " & gintPROJID ' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID crJobCost.ReportFileName = App.Path & "\jobcostProj2.rpt" crJobCost.SelectionFormula = strSQL crJobCost.CopiesToPrinter = gintCOPY If mboolWINDOW = True Then crJobCost.Destination = crptToWindow End If If mboolREPORT = True Then crJobCost.Destination = crptToPrinter End If crJobCost.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form JCList - Module JCPrint2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ToggleButtons() ' cmdFind.Enabled = Not cmdFind.Enabled cmdFlush.Enabled = Not cmdFlush.Enabled cmdProcess.Enabled = Not cmdProcess.Enabled cmdSelectAll.Enabled = Not cmdSelectAll.Enabled cmdDelete.Enabled = Not cmdDelete.Enabled cmdProcess2.Enabled = Not cmdProcess2.Enabled cmdFindProj.Enabled = Not cmdFindProj.Enabled cmdExit.Enabled = Not cmdExit.Enabled End Sub