azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
956a39b631581bc5697dfdfbbac90eb843b900ae
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmPayList.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

1751 lines
57 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 frmPayList
Caption = "Payroll List"
ClientHeight = 8625
ClientLeft = 60
ClientTop = 345
ClientWidth = 9030
ControlBox = 0 'False
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 8625
ScaleWidth = 9030
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmd1DailyTS
Caption = "1 Daily Time Sht"
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 = 555
Left = 2400
TabIndex = 25
Top = 7380
Width = 1035
End
Begin LpLib.fpList lstPayCrews
Height = 3675
Left = 45
TabIndex = 24
Top = 1545
Width = 4590
_Version = 196608
_ExtentX = 8096
_ExtentY = 6482
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Microsoft 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 = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 255
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayList.frx":0000
End
Begin VB.CommandButton cmdPrDetail
Caption = "Print Pay Detail"
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 = 555
Left = 1275
TabIndex = 23
Top = 8025
Width = 1035
End
Begin VB.CommandButton cmdUpEmpMaster
Caption = "Up Emp Master"
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 = 555
Left = 1275
TabIndex = 22
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmdMoveMAS90
Caption = "Move PR to CMS"
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 = 555
Left = 3540
TabIndex = 21
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmdPRProcess
Caption = "Setup PR for CMS"
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 = 555
Left = 120
TabIndex = 20
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmd1TimeSheet
Caption = "1 Time Sheet"
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 = 555
Left = 2400
TabIndex = 19
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrintPayLog
Caption = "Payroll Log"
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 = 555
Left = 1275
TabIndex = 18
TabStop = 0 'False
Top = 6705
Width = 1035
End
Begin VB.CommandButton cmdPrint1Crew
Caption = "1 Crew Summary"
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 = 555
Left = 3540
TabIndex = 17
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrint1
Caption = "1 VWP Summary"
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 = 555
Left = 120
TabIndex = 16
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrintTimeSheets
Caption = "Time Sheets"
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 = 555
Left = 2400
TabIndex = 15
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin VB.CommandButton cmdPrintData
Caption = "Data Input Sheet"
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 = 555
Left = 1260
TabIndex = 14
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin VB.CommandButton cmdPrintCrew
Caption = "Print Crew Summary"
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 = 555
Left = 3540
TabIndex = 13
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin Crystal.CrystalReport crPay
Left = 6900
Top = 5520
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "Print VWP Summary"
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 = 555
Left = 135
TabIndex = 12
TabStop = 0 'False
Top = 6045
Width = 1035
End
Begin VB.CommandButton cmdAddMember
Caption = "Add &Members"
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 = 555
Left = 1260
TabIndex = 5
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2400
TabIndex = 6
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.TextBox txtCrewID
Height = 375
Left = 5160
TabIndex = 11
TabStop = 0 'False
Top = 5580
Visible = 0 'False
Width = 1215
End
Begin VB.ListBox lstCrew
Height = 3765
Left = 4680
Sorted = -1 'True
TabIndex = 8
TabStop = 0 'False
Top = 1560
Width = 4215
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Crew"
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 = 555
Left = 3540
TabIndex = 7
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.CommandButton cmdAdd
Caption = "&Add Crew"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 135
TabIndex = 4
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.ListBox lstPayCrews2
Height = 450
Left = 4725
TabIndex = 2
Top = 6270
Width = 4350
End
Begin MSComCtl2.DTPicker dtpPayDate
Height = 315
Left = 1320
TabIndex = 0
Top = 180
Width = 1215
_ExtentX = 2143
_ExtentY = 556
_Version = 393216
Format = 94830593
CurrentDate = 43240
MaxDate = 55153
MinDate = 36892
End
Begin VB.Label lblCrewInstruct
Caption = "Double Click or CTRL S on the desired crew listed below to add the crew to the current payroll list."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 5340
TabIndex = 10
Top = 660
Width = 2955
End
Begin VB.Label lblInstruct
Caption = "Double Click or CTRL P on the desired crew to view payroll informaton for that crew for the payroll date shown."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 180
TabIndex = 9
Top = 600
Width = 4395
End
Begin VB.Label lblCrew
AutoSize = -1 'True
Caption = "Crews for this payroll:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 180
TabIndex = 3
Top = 1320
Width = 1845
End
Begin VB.Label lblPRDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payroll Date:"
Height = 195
Left = 360
TabIndex = 1
Top = 240
Width = 900
End
End
Attribute VB_Name = "frmPayList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSPay As Recordset
Dim moRSCREW As Recordset
Dim mboolAdding As Boolean, mboolPAINT As Boolean
Private Sub cmd1TimeSheet_Click()
Dim strSQL As String, strSql2 As String, intYN As Integer
Dim oRS As Recordset, intCREWID As Long ', intCREWID As Integer
On Error GoTo Error_EH
intYN = vbYes
'*Need to identify paint pay sheets *************************************************************
gintPRINT = 1
lstPayCrews.col = 1
intCREWID = Field2Integer(lstPayCrews.ColText)
strSQL = "{tblcrew.crew_id} = " & intCREWID '3
' strSQL = "{tblcrew.crew_id} = " & Left$(lstPayCrews.Text, 4) '3
If mboolPAINT Then
crPAY.ReportFileName = App.Path & "\timesheetNewX.rpt"
Else
crPAY.ReportFileName = App.Path & "\timesheetNew.rpt"
End If
' crPay.ReportFileName = App.Path & "\timesheet.rpt"
crPAY.SelectionFormula = strSQL
crPAY.Destination = crptToPrinter
crPAY.CopiesToPrinter = 1
crPAY.Action = 1
' ***************** Print Daily Pay Sheet - 5 copies
'' intYN = MsgBox("Do You Want To Print Daily Sheets?", vbYesNo + vbDefaultButton1, "Print Dailys")
' intYN = MsgBox("Do You Want To Print Daily Sheets?", "Print Dailys", vbYes)
' intYN = InputBox("Do You Want To Print Daily Sheets?", "Print Dailys", vbYes)
'' If intYN = vbYes Then
'' gintPRINT = 5
' lstPayCrews.col = 1
'' lstPayCrews.col = 0
'' intCREWID = Field2Long(lstPayCrews.ColText)
' intCREWID = Field2Integer(lstPayCrews.ColText)
'' strSQL = "{tblpayCrew.Pay_id} = " & intCREWID '3
'' crPay.ReportFileName = App.Path & "\dailyTimeSheet.rpt"
'' crPay.SelectionFormula = strSQL
'' crPay.Destination = crptToPrinter
'' crPay.CopiesToPrinter = gintPRINT
'' crPay.Action = 1
'' End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmd1TimeSheet_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmd1DailyTS_Click()
Dim strSQL As String, strSql2 As String, intYN As Integer
Dim oRS As Recordset, intCREWID As Long ', intCREWID As Integer
On Error GoTo Error_EH
'' intYN = vbYes
'*Need to identify paint pay sheets *************************************************************
'' gintPRINT = 1
'' lstPayCrews.col = 1
'' intCREWID = Field2Integer(lstPayCrews.ColText)
'' strSQL = "{tblcrew.crew_id} = " & intCREWID '3
' strSQL = "{tblcrew.crew_id} = " & Left$(lstPayCrews.Text, 4) '3
'' If mboolPAINT Then
'' crPay.ReportFileName = App.Path & "\timesheetNewX.rpt"
'' Else
'' crPay.ReportFileName = App.Path & "\timesheetNew.rpt"
'' End If
' crPay.ReportFileName = App.Path & "\timesheet.rpt"
'' crPay.SelectionFormula = strSQL
'' crPay.Destination = crptToPrinter
'' crPay.CopiesToPrinter = 1
'' crPay.Action = 1
' ***************** Print Daily Pay Sheet - 5 copies
'' intYN = MsgBox("Do You Want To Print Daily Sheets?", vbYesNo + vbDefaultButton1, "Print Dailys")
' intYN = MsgBox("Do You Want To Print Daily Sheets?", "Print Dailys", vbYes)
' intYN = InputBox("Do You Want To Print Daily Sheets?", "Print Dailys", vbYes)
'' If intYN = vbYes Then
gintPRINT = 5
' lstPayCrews.col = 1
lstPayCrews.col = 0
intCREWID = Field2Long(lstPayCrews.ColText)
' intCREWID = Field2Integer(lstPayCrews.ColText)
strSQL = "{tblpayCrew.Pay_id} = " & intCREWID '3
crPAY.ReportFileName = App.Path & "\dailyTimeSheet.rpt"
crPAY.SelectionFormula = strSQL
crPAY.Destination = crptToPrinter
crPAY.CopiesToPrinter = gintPRINT
crPAY.Action = 1
'' End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmd1DailyTimeSheet_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAdd_Click()
Dim intID As Integer, strSQL As String, lngINDEX As Long, lngFind As Long
Dim oRS As Recordset
On Error GoTo Error_EH
cmdAdd.Enabled = False
cmdDelete.Enabled = False
'Code to Add a Crew
mboolAdding = True
intID = InputBox("Enter The Crew Number To Add", "Crew Number", 9999)
If intID > 0 Then
strSQL = "SELECT Crew_id, Crew_Boss, Type, Inactive FROM tblCREW WHERE crew_id = " & intID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
If oRS!inactive Then
MsgBox "This Crew - " & oRS!Crew_Boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew"
cmdAdd.Enabled = True
Exit Sub
End If
End If
If oRS.EOF Then
Call CrewLoad
Else
txtCrewId = oRS!CREW_ID
Call FormSave
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
cmdAdd.SetFocus
End If
Else
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
cmdAdd.SetFocus
Exit Sub
End If
lngFind = Field2Long(intID)
Call CBFindString2(lstPayCrews, Field2Str(intID))
' lstPayCrews.SetFocus
' lngINDEX = ListFindItem(lstPayCrews, lngFind)
' Call ListFindItem3(lstPayCrews, lngFind)
' lstPayCrews.ListIndex = lngINDEX
Exit Sub
Error_EH:
If Err.Number = 13 Then
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
Resume Next
End If
gstrMODULE = "Form PayList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
oRS.AddNew
oRS!C_USER = gstrLOGIN
End If
With oRS
!U_USER = gstrLOGIN
!Updated = Date
!CREW_ID = txtCrewId
!Pay_Date = dtpPayDate.Value
End With
oRS.Update
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
Resume Next
End If
gstrMODULE = "Form PayList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSave
' moRSPay.Update
If mboolAdding Then
mboolAdding = False
End If
Call PayLoad
Exit Sub
Error_EH:
' Call ErrorHandler(moRSPay.ActiveConnection)
gstrMODULE = "Form PayList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PayLoad()
Dim oRS As Recordset
Dim strSQL As String, strCREW As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblPayHeader WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY crew_id"
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPayCrews.Clear
Do Until moRSCREW.EOF
With lstPayCrews
strCREW = "SELECT * FROM tblCrew where CREW_id = " & moRSCREW!CREW_ID
Set oRS = New Recordset
oRS.Open strCREW, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
strLine = Field2Str(moRSCREW!pay_id) & vbTab & Field2Str(moRSCREW!CREW_ID) & vbTab & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!Crew_Boss)
.AddItem strLine
' .ItemData(.NewIndex) = moRSCREW!pay_id
' strLine = Field2Str(moRSCREW!crew_id) & " " & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!crew_boss)
' .AddItem strLine
' .ItemData(.NewIndex) = moRSCREW!pay_id
End If
End With
moRSCREW.MoveNext
Loop
moRSCREW.Close
If lstPayCrews.ListCount Then
lstPayCrews.ListIndex = 0
cmdAddMember.Enabled = True
cmdDelete.Enabled = True
cmdPrint.Enabled = True
cmdPrintCrew.Enabled = True
cmdPrintData.Enabled = True
cmdPrintTimeSheets.Enabled = True
cmdPrint1.Enabled = True
cmdPrint1Crew.Enabled = True
cmdPrintPayLog.Enabled = True
cmd1TimeSheet.Enabled = True
cmd1DailyTS.Enabled = True
cmdPRProcess.Enabled = True
cmdUpEmpMaster.Enabled = True
cmdMoveMAS90.Enabled = True
cmdPrDetail.Enabled = False
' cmdPrDetail.Enabled = True ' remove to turn back on.
lstPayCrews.col = 0
gintPAYID = Field2Long(lstPayCrews.ColText)
Else
cmdAddMember.Enabled = False
cmdDelete.Enabled = False
cmdPrint.Enabled = False
cmdPrintCrew.Enabled = False
cmdPrintData.Enabled = False
cmdPrintTimeSheets.Enabled = False
cmdPrint1.Enabled = False
cmdPrint1Crew.Enabled = False
cmdPrintPayLog.Enabled = False
cmd1TimeSheet.Enabled = False
cmd1DailyTS.Enabled = False
cmdPRProcess.Enabled = False
cmdUpEmpMaster.Enabled = False
cmdMoveMAS90.Enabled = False
cmdPrDetail.Enabled = False
' Call ChangeButton
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module PayLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAddMember_Click()
Dim intINDEX As Integer
If lstPayCrews.ListIndex <> -1 Then
intINDEX = lstPayCrews.ListIndex
lstPayCrews.col = 1
gintCREWID = lstPayCrews.ColText
' gintCREWID = Left$(Field2Str2(lstPayCrews.Text), 4) '1
frmCrewList.Show 1
Call PayLoad
lstPayCrews.ListIndex = intINDEX
Else
MsgBox "You Must Select A Crew", vbOKOnly, "Select Crew"
Exit Sub
End If
End Sub
Private Sub cmdDelete_Click()
Dim strSQL As String, strYN As String, intPAYID As Long
strYN = MsgBox("Are You Sure You Want To Delete This Crew?", vbCritical + vbYesNo, "Delete?")
If strYN <> vbYes Then
Exit Sub
End If
lstPayCrews.col = 0
intPAYID = Field2Long(lstPayCrews.ColText)
' intPAYID = Field2Integer(lstPayCrews.ColText)
strSQL = "DELETE * FROM tblTIME where pay_id = " & intPAYID
' strSQL = "DELETE * FROM tblTIME where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPayCrew where pay_id = " & intPAYID
' strSQL = "DELETE * FROM tblPayCrew where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPayHeader WHERE pay_id = " & intPAYID
' strSQL = "DELETE * FROM tblPayHeader WHERE pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
Call PayLoad
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrintVWP_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintVWP_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdMoveMAS90_Click()
Call CMSPRTransfer
End Sub
Private Sub cmdMoveMAS90_Click_Hold()
MsgBox "Go to CMS and Import the Payroll As Daily Units", vbOKOnly, "Goto MAS90"
End Sub
Private Sub cmdPrDetail_Click()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, intYN As Integer
Dim strSELECT As String
Dim strBegDate As String, strEndDate As String
Dim intBYear As String, intBMonth As String, intBDay As String
Dim intEYear As String, intEMonth As String, intEDay As String
On Error GoTo Error_EH
gboolPRINT = True
intYN = MsgBox("Remember to Update Check Information Before Printing - Are You Ready?", vbYesNo, "Ready to Print")
If intYN = vbNo Then
Exit Sub
End If
intYN = MsgBox("Do You Want To Print to the Printer?", vbYesNo, "Window or Printer")
If gboolPRINT Then
' strDate = dtpPayDate.Value
strDate = Format(dtpPayDate.Value, "MM/DD/YYYY")
intBYear = Mid(strDate, 7, 4)
intBDay = Format(Mid(strDate, 4, 2), "00")
intBMonth = Format(Mid(strDate, 1, 2), "00")
' intEYear = Mid(txtEndDate, 7, 4)
' intEDay = Format(Mid(txtEndDate, 4, 2), "00")
' intEMonth = Format(Mid(txtEndDate, 1, 2), "00")
crPAY.ReportFileName = App.Path & "\PayDetail.rpt"
crPAY.Formulas(3) = "ZZ_Date = Date(" & intBYear & "," & intBMonth & "," & intBDay & ")"
' crpay.Formulas(4) = "Z_Crew = " & mintCREW
' crpay.Formulas(5) = "Z_EndDate = Date(" & intEYear & "," & intEMonth & "," & intEDay & ")"
If intYN = vbYes Then
crPAY.Destination = crptToPrinter
Else
crPAY.Destination = crptToWindow
End If
crPAY.Action = 1
gboolPRINT = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrDetail_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint1_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, intPAYID As Long
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
' Set oRS = New Recordset
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
' oRS.MoveFirst
' Do Until oRS.EOF
lstPayCrews.col = 0
intPAYID = Field2Long(lstPayCrews.ColText)
' intPAYID = Field2Integer(lstPayCrews.ColText)
strSQL = "{tblpayheader.pay_id} = " & intPAYID
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint1_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint1Crew_Click()
Dim strSQL As String, intPAYID As Long ', strSQL2 As String
'Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
lstPayCrews.col = 0
intPAYID = Field2Long(lstPayCrews.ColText)
' intPAYID = Field2Integer(lstPayCrews.ColText)
strSQL = "{tblpayheader.pay_id} = " & intPAYID
crPAY.ReportFileName = App.Path & "\payinfo2.rpt"
crPAY.SelectionFormula = strSQL
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint1Crew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintCrew_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPAY.ReportFileName = App.Path & "\payinfo2.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintCrew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintData_Click()
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
intMonth = Month(dtpPayDate.Value)
intDay = Day(dtpPayDate.Value)
intYear = Year(dtpPayDate.Value)
' Do Until oRS.EOF
strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
crPAY.ReportFileName = App.Path & "\paylist.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintData_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintPayLog_Click()
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
intMonth = Month(dtpPayDate)
intDay = Day(dtpPayDate)
intYear = Year(dtpPayDate)
' Do Until oRS.EOF
' strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
' Set oRS = New Recordset
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
' oRS.MoveFirst
' Do Until oRS.EOF
strSQL = "{tblpayheader.pay_Date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
crPAY.ReportFileName = App.Path & "\paylog.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Destination = gintDEST
crPAY.CopiesToPrinter = gintCOPY
crPAY.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintTimeSheets_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
' frmReport.Show 1
strSql2 = "SELECT pay_id, crew_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblcrew.crew_id} = " & Field2Str2(oRS!CREW_ID)
crPAY.ReportFileName = App.Path & "\timesheetNew.rpt"
' crPay.ReportFileName = App.Path & "\timesheet.rpt"
crPAY.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
crPAY.Destination = crptToPrinter
' crPay.Destination = gintDEST
crPAY.CopiesToPrinter = 1
crPAY.Action = 1
' ***************** Print Daily Pay Sheet - 5 copies
gintPRINT = 5
' lstPayCrews.col = 0
' intCREWID = Field2Integer(lstPayCrews.ColText)
strSQL = "{tblpayCrew.Pay_id} = " & Field2Str2(oRS!pay_id) '3
crPAY.ReportFileName = App.Path & "\dailyTimeSheet.rpt"
crPAY.SelectionFormula = strSQL
crPAY.Destination = crptToPrinter
crPAY.CopiesToPrinter = gintPRINT
crPAY.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintTimeSheet_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPRProcess_Click()
Dim strSQL As String, strSql2 As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset
Screen.MousePointer = vbHourglass
' On Error GoTo Error_EH
strSql2 = "DELETE * FROM tblPayroll"
goConn.Execute strSql2
strSQL = "SELECT * FROM tblPayHeader where Pay_Date = #" & dtpPayDate.Value & "# and p_flag"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblPayroll"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id)
Set oRT = New Recordset
oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
Do Until oRT.EOF
With oRT
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!hours)
oRSS!amount = Field2Str2(!gross)
' oRSS!amount = Field2Str2(!Reg_Wage)
oRSS!Rate = Field2Str2(!Rate)
oRSS!wc_code = Field2Str(!wc_code)
oRSS!earncode = "1"
' oRSS!earncode = "11"
oRSS!OT_Hours = Field2Str2(!OT_Hours)
oRSS!OT_Amt = Field2Str2(!OT_Wage)
oRSS!OT_TRANS = Field2Str2(!OT_Wage) / 1.5
oRSS!REG_TRANS = Field2Str2(!REG_WAGE)
' oRSS!earncode = "01"
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS.Update
End With
oRT.MoveNext
Loop
oRS!P_FLAG = vbUnchecked
oRS.Update
oRS.MoveNext
Loop
Screen.MousePointer = vbDefault
MsgBox "Payroll Is Ready To Be Imported Into CMS - Click On 'Move PR To CMS' to Setup Transfer File"
cmdMoveMAS90.SetFocus
' cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub cmdUpEmp_Click()
frmEmployee.Show
End Sub
Private Sub cmdUpEmpMaster_ClickOLD()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
Screen.MousePointer = vbHourglass
On Error GoTo Error_EH
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
strSql2 = "DELETE * FROM PR1_EmployeeMaster"
goConn.Execute strSql2
strSql2 = "SELECT department, employeenumber, lastname, firstname, socialsecuritynumber, DefaultWCCode, Terminated FROM PR1_EmployeeMaster"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSS.EOF
strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE employeenumber = '" & Field2Str(oRSS!EmployeeNumber) & "' and department = '" & Field2Str(oRSS!department) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
oRS.AddNew
oRS!department = Field2Str(oRSS!department)
oRS!EmployeeNumber = Field2Str(oRSS!EmployeeNumber)
oRS!LastName = Field2Str(Trim$(oRSS!LastName))
oRS!FirstName = Field2Str(Trim$(oRSS!FirstName))
oRS!SocialSecurityNumber = Field2Str(oRSS!SocialSecurityNumber)
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!Terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
ElseIf Field2Str(oRSS!department) <> Field2Str(oRS!department) Then
oRS.Delete
oRS.AddNew
oRS!department = Field2Str(oRSS!department)
oRS!EmployeeNumber = Field2Str(oRSS!EmployeeNumber)
oRS!LastName = Field2Str(Trim$(oRSS!LastName))
oRS!FirstName = Field2Str(Trim$(oRSS!FirstName))
oRS!SocialSecurityNumber = Field2Str(oRSS!SocialSecurityNumber)
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!Terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
' End If
Else
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!Terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
End If
oRSS.MoveNext
Loop
Screen.MousePointer = vbDefault
MsgBox "Employee Master Information Has Been Updated"
cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub cmdUpEmpMaster_Click()
frmEmployee.Show
End Sub
Private Sub dtpPayDate_Change()
Call PayLoad
cmdAdd.SetFocus
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
glngPSID = 0
' mboolSETUP = False
' mboolENTER = False
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = vbKeyP Then ' Display key combinations.
If CtrlDown Then
Call lstPayCrews_DblClick
' Call PayLoad
' Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyA Then ' Display key combinations.
If CtrlDown Then
Call cmdAdd_Click
' Call CrewLoad
' Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyM Then ' Display key combinations.
If CtrlDown Then
Call cmdAddMember_Click
' Call CrewLoad
' Call cmdTotal_Click
' Call lstLots_DblClick
End If
Exit Sub
End If
If KeyCode = vbKeyS Then ' Display key combinations.
If CtrlDown Then
Call lstCrew_DblClick
' Call CrewLoad
' Call cmdTotal_Click
' Call lstLots_DblClick
End If
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()
On Error GoTo Error_EH
frmPayList.Width = 4725
dtpPayDate.Value = Date
Call PayLoad
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblCrew Order BY Crew_Boss"
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
Do Until moRSCREW.EOF
With lstCrew
.AddItem Field2Str(moRSCREW!Crew_Boss)
.ItemData(.NewIndex) = moRSCREW!CREW_ID
End With
moRSCREW.MoveNext
Loop
' moRSCrew.Close
frmPayList.Width = 9150
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_DblClick()
txtCrewId = lstCrew.ItemData(lstCrew.ListIndex)
frmPayList.Width = 4725
cmdAdd.Enabled = True
cmdDelete.Enabled = True
Call FormSave
End Sub
Private Sub lstPayCrews_Click()
Dim strCrewType As String
lstPayCrews.col = 2
strCrewType = Field2Str(lstPayCrews.ColText)
If strCrewType = "X" Then
mboolPAINT = True
Else
mboolPAINT = False
End If
End Sub
Private Sub lstPayCrews_DblClick()
Dim strName As String, intPAYID As Long
lstPayCrews.col = 0
' intPAYID = Field2Integer(lstPayCrews.ColText)
intPAYID = Field2Long(lstPayCrews.ColText)
gintPAYID = intPAYID
lstPayCrews.col = 1
gintCREWID = CInt(lstPayCrews.ColText) '2
' gintCREWID = CInt(Left(lstPayCrews.Text, 4)) '2
Load frmPayHead
lstPayCrews.col = 3
strName = lstPayCrews.ColText
frmPayHead.lblCrewName = strName
frmPayHead.txtPayDate = dtpPayDate.Value
frmPayHead.txtCrewId = gintCREWID
lstPayCrews.col = 2
frmPayHead.lblTYPE3 = lstPayCrews.ColText
frmPayHead.Show 1
End Sub
Private Sub CMSPRTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strREGWAGE, strOTWAGE, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strREGHOUR, strOTHOUR ', strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String, strINV_DUE_Date As String, strDISC_Date As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long, strHR As String
Dim strMONTH As String, strDAY As String, strSEC As String, strWCCODE As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strDISC_PCT As String, strDISCYN As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
' strMIN = Format(Minute(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
strFile = "PREXT" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblPAYROLL ORDER BY EMPLOYEE_NO"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".csv" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
Do Until oRSSS.EOF
strCUSTNo = oRSSS!employee_no
strINVDATE = dtpPayDate.Value
' strTType = "1"
strTType = "11"
strWCCODE = oRSSS!wc_code
strREGWAGE = oRSSS!REG_TRANS
' strREGWAGE = oRSSS!amount
strOTWAGE = oRSSS!OT_TRANS
' strOTWAGE = oRSSS!OT_Amt
strREGHOUR = oRSSS!HOURS_WAGES
' strOTHOUR = "2"
strOTHOUR = oRSSS!OT_Hours
strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & strREGWAGE & "," & strOTWAGE & "," & "," & "," & "," & ","
strHEADER = strHEADER & "," & "," ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
' strHEADER = strCUSTNo & vbTab & strINVDATE & vbTab & strTType & vbTab & strWCCODE & vbTab & strREGWAGE & vbTab & strOTWAGE & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHEADER & vbTab & vbTab ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
TStream.WriteLine (strHEADER)
strTType = "9"
strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & "," & "," & "," & "," & "," & strREGHOUR & ","
strHEADER = strHEADER & "," & "," & strOTHOUR ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
TStream.WriteLine (strHEADER)
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Payroll and IMPORT DAILY using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
cmdExit.SetFocus
End Sub
Private Sub CMSHRTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strREGWAGE, strOTWAGE, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strREGHOUR, strOTHOUR ', strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String, strINV_DUE_Date As String, strDISC_Date As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long, strHR As String
Dim strMONTH As String, strDAY As String, strSEC As String, strWCCODE As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strDISC_PCT As String, strDISCYN As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
' strMIN = Format(Minute(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
strFile = "PREXT" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblPAYROLL ORDER BY EMPLOYEE_NO"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".csv" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
Do Until oRSSS.EOF
strCUSTNo = oRSSS!employee_no
strINVDATE = dtpPayDate.Value
' strTType = "1"
strTType = "11"
strWCCODE = oRSSS!wc_code
strREGWAGE = oRSSS!REG_TRANS
' strREGWAGE = oRSSS!amount
strOTWAGE = oRSSS!OT_TRANS
' strOTWAGE = oRSSS!OT_Amt
strREGHOUR = oRSSS!HOURS_WAGES
' strOTHOUR = "2"
strOTHOUR = oRSSS!OT_Hours
strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & strREGWAGE & "," & strOTWAGE & "," & "," & "," & "," & ","
strHEADER = strHEADER & "," & "," ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
' strHEADER = strCUSTNo & vbTab & strINVDATE & vbTab & strTType & vbTab & strWCCODE & vbTab & strREGWAGE & vbTab & strOTWAGE & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHEADER & vbTab & vbTab ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
TStream.WriteLine (strHEADER)
strTType = "9"
strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & "," & "," & "," & "," & "," & strREGHOUR & ","
strHEADER = strHEADER & "," & "," & strOTHOUR ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
TStream.WriteLine (strHEADER)
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Payroll and IMPORT DAILY using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
cmdExit.SetFocus
End Sub
Reference in New Issue View Git Blame Copy Permalink