azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f67db6f1f2da43ce0376431f7e9d31ef74f2ad41
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmJCList.frm
Mike Swanson fccf9f9468 sync: auto-sync from GURU-5070 at 2026-06-14 05:33:01 
Author: Mike Swanson
Machine: GURU-5070
Timestamp: 2026-06-14 05:33:01
2026-06-14 05:34:46 -07:00

2541 lines
79 KiB
Plaintext
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink