frm_kaoqihesuan2.frm

考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支

Private Sub GurhanButton1_Click(Index As Integer)


    'On Error GoTo Err1
    On Error Resume Next


    Dim mancount As Integer

    Dim i As Integer
    
    ReDim mvList(List1.ListCount - 1)
    'Dim strList As String
    'strList = ""

    For i = 0 To List1.ListCount - 1
        mvList(i) = List1.List(i)
        'strList = strList & "'" & List1.List(i) & "'" & ","
        'Debug.Print mvList(i)
    Next i
    'strList = Left(strList, Len(strList) - 1)

    'Dim bgtm As Date
    'Dim t1 As Integer
    'Dim Maxid As Long
    '
    'strSQL = "select max(crdtmid) as maxid from empcrdtm"
    'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    'If IsNull(adoprimaryRS.Fields("maxid").Value) Then
    '    Maxid = 1
    'Else
    '    Maxid = adoprimaryRS.Fields("maxid").Value
    'End If






    ''    strSQL = "select top 10 * from empcrdtm"      '''''自动考勒所用的表；
    '    strSQL = "select  * from empcrdtm where 1=2"
    '    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)




    'Dim sBuMen As String
    'For i = 0 To List1.ListCount - 1
    'sBuMen = sBuMen & "'" & List1.List(i) & "',"
    'Next i
    'If Len(sBuMen) > 2 Then
    'sBuMen = Left(sBuMen, Len(sBuMen) - 1)
    'Else
    'sBuMen = ""
    'End If
    'Debug.Print sBuMen


    Select Case Index
        Case 0
     

            strSQL2 = "delete from emplytmp"
            mDB.ExecuteSQL strSQL2

            For i = 0 To List1.ListCount - 1
                strSQL2 = "insert into emplytmp select emplyid,serial from emply,depart where  depart.dptid=emply.dptid and emply.empcrdyn=1 and dptname ='" & List1.List(i) & "'"
                Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            Next i

            strSQL2 = "select * from emplytmp"
            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            mancount = adoPrimaryRS2.RecordCount



            'strSQL2 = "select emplytmp.emplyid,emplytmp.serial from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "' amd ((outdate is null) or (outdate<'" & DTPicker1(0).Value & "'))"
            strSQL2 = "delete from emplytp"
            mDB.ExecuteSQL strSQL2
            'strSQL2 = "insert into emplytp select emplytmp.emplyid,emplytmp.serial from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "' and outdate<='" & DTPicker1(0).Value & "'"
            strSQL2 = "insert into emplytp(emplyid,serial,indate,outdate) select emplytmp.emplyid,emplytmp.serial,indate,outdate from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "'"
            mDB.ExecuteSQL strSQL2
            'strSQL2 = "select emplytp.emplyid,serial from emplytp,emply2 where emplytp.emplyid=emply2.emplyid and  ((outdate is null) or (outdate>'" & DTPicker1(0).Value & "'))"
            'strSQL2 = "select emplytp.emplyid,serial from emplytp where (outdate is null) or (outdate>'" & DTPicker1(0).Value & "')"
            
            
                    strSQL2 = "select emplytp.emplyid,serial from emplytp where  (outdate is null) or (outdate>'" & DTPicker1(0).Value & "')"
    
            '            strSQL2 = "select c.dptname,b.emplyid,b.emplyname,a.indate,a.outdate,left(d.wktmbg,10) as bgdate,e.wktmdays,e.regualorder from emplytp a,emply b,depart c,empwktm d,wktmregual e,wktm f where b.emplyid=d.emplyid and d.regualid=e.regualid and e.wktmid=f.wktmid and a.emplyid=b.emplyid and b.dptid=c.dptid"
            strSQL2 = "select c.dptid,c.dptname,b.emplyid,b.emplyname,a.indate,a.outdate,left(d.wktmbg,10) as bgdate,d.regualid from  emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid  and a.emplyid=b.emplyid and b.dptid=c.dptid"
            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)

            If adoPrimaryRS2.RecordCount = 0 Then
                MsgBox "你所选择的部门无员工，请重新选择。谢谢。", vbOKOnly, "NewAsia"
                Exit Sub
            Else
                If MsgBox("共有" & mancount & "_" & adoPrimaryRS2.RecordCount & "人参与考勤核算", vbYesNo, "NewAsia") = vbNo Then
                    Screen.MousePointer = 0
                    Exit Sub
                End If
            End If
            
ReDo:
            strSQL = "delete from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid in (select b.emplyid from emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid  and a.emplyid=b.emplyid and b.dptid=c.dptid)"
            mDB.ExecuteSQL strSQL
            strSQL = "select count(*) from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid in (select b.emplyid from emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid  and a.emplyid=b.emplyid and b.dptid=c.dptid)"
            Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
            If adoprimaryRS(0).Value Then GoTo ReDo

            
            
            
            Dim nCount As Long           '''''''''核算进度（已核算人数）
   
            
            
            
            Screen.MousePointer = 11

            strSQL = "select max(ID) from wktmrslt"
            Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
            Dim Maxid As Long
            Maxid = adoprimaryRS(0).Value

            strSQL = "select * from wktmsys"
            Set adoprimaryRS = mDB.adoprimaryRS(strSQL)

            Dim tChiDao As Integer                    '  迟到
            Dim tZaoTui As Integer                    '  早退
            Dim tChiDao2 As Integer                   '  在上班    分钟后记旷工；
            Dim tZaoTui2 As Integer                   '  在下班    分钟后记旷工；
            Dim tWuXiao As Integer                    '  前后两次打卡在    分钟内记为无效打卡；
            Dim iFen As Integer                       '  在下班    分钟后打卡记加班有效；（在允许延时加班的情况下）

            With adoprimaryRS
                .Filter = "sysid=1"
                tChiDao = .Fields("condition").Value
                .Filter = "sysid=2"
                tZaoTui = .Fields("condition").Value
                .Filter = "sysid=3"
                tChiDao2 = .Fields("condition").Value
                .Filter = "sysid=4"
                tZaoTui2 = .Fields("condition").Value
                .Filter = "sysid=5"
                tWuXiao = .Fields("condition").Value
                .Filter = "sysid=6"
                iFen = .Fields("condition").Value
            End With
 
 
            strSQL3 = "select e.wktmid,f.wktmdecs,e.wktmdays,e.regualorder,f.hours,e.regualid,bgnwktm1,bgntm1,endtm1,endwktm1,bgnwktm2,bgntm2,endtm2,endwktm2,bgnwktm3,bgntm3,endtm3,endwktm3 from wktmregual e,wktm f where   e.wktmid=f.wktmid order by e.regualorder"
            Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)
            '  Debug.Print adoPrimaryRS3.RecordCount

    
            Dim iZQ As Integer       ''''周期
            Dim bgnwktm1 As Date
            Dim bgntm1 As Date
            Dim endtm1 As Date
            Dim endwktm1 As Date
            Dim bgnwktm2 As Date
            Dim bgntm2 As Date
            Dim endtm2 As Date
            Dim endwktm2 As Date
            Dim bgnwktm3 As Date
            Dim bgntm3 As Date
            Dim endtm3 As Date
            Dim endwktm3 As Date


            Dim bgntm11 As Date
            Dim bgntm22 As Date


            Dim fromD As Date
            Dim toD As Date

            iZQ = adoPrimaryRS3("wktmdays").Value


            Dim ii As Integer
            Dim JJ As Integer
            Dim iJS As Integer
            Dim n As Integer

            Dim iCount As Integer
            iCount = DTPicker1(1).Value - DTPicker1(0).Value

            Dim d As Date
            Dim dd As Date

            Dim iStart As Integer


            Dim nm As Long


            strSQL4 = "select * from  empcrdtm where cdatetime>'" & DTPicker1(0).Value & "' and cdatetime<'" & DTPicker1(1).Value + 1 & "' order by cdatetime"
            Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)

            strSQL5 = "select * from wktmrslt where 1=2"
            Set adoPrimaryRS5 = mDB.adoRSBatch(strSQL5)

            With adoPrimaryRS2
                .MoveFirst
                Do While Not .EOF
                    d = DTPicker1(0).Value
                    dd = d
                    iStart = DateDiff("d", .Fields("bgdate").Value, d) Mod iZQ
                    '   iStart = Abs(DateDiff("d", .Fields("bgdate").Value, d) Mod iZQ)
                    If iStart < 0 Then
                        iStart = iStart + iZQ
                    End If
                    '    Debug.Print DateDiff("d", .Fields("bgdate").Value, d)
                    '    ii = iStart + 1
                    'ii = iStart
                    'If ii = 0 Then ii = 1
                    ii = iStart + 1
                    If ii = 0 Then ii = iZQ
                    '    Debug.Print ii
    
    
                    StatusBar1.Panels(2).Text = .Fields("emplyname").Value
                    StatusBar1.Panels(4).Text = .Fields("emplyid").Value
                    '    nm = nm + 1
                    '    StatusBar1.Panels(3).Text = nm
    
    
    
                    adoPrimaryRS3.Filter = "regualid=" & adoPrimaryRS2.Fields("regualid").Value
    
                    For i = 0 To iCount     '''''核算天数
                        '''''''''''''''''***************************************
                        '''''未进厂 或 已离职；
                        If .Fields("indate").Value > d Or (Not IsNull(.Fields("outdate").Value) And .Fields("indate").Value <= d) Then
                            GoTo Next1
                        End If
                        '''''''''''''''''***************************************
                        StatusBar1.Panels(5).Text = d
                        'Debug.Print adoPrimaryRS3.RecordCount

                        adoPrimaryRS3.Find "regualorder=" & ii, 0, adSearchForward, adBookmarkFirst
                        '    adoPrimaryRS3.Find "regualorder=" & ii, 0, adSearchForward, adBookmarkFirst
                        bgnwktm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgnwktm1").Value, 11)
                        bgntm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgntm1").Value, 11)
                        endtm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endtm1").Value, 11)
                        endwktm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endwktm1").Value, 11)
    
                        bgnwktm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgnwktm2").Value, 11)
                        bgntm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgntm2").Value, 11)
                        endtm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endtm2").Value, 11)
                        endwktm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endwktm2").Value, 11)