frm_rpt_kaoqin.frm

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

  tmpTime = "2005-12-26 07:00:00"
  Else
  tmpTime = adoPrimaryRS3.Fields("bgnwktm1").Value
  End If
  
 If adoPrimaryRS3.RecordCount = 0 Then
 MsgBox "请先设置好班次。"
 Exit Sub
 End If
 
' If (Weekday(tmpdate) = 1 Or Weekday(tmpdate) = 7) Then
' MsgBox "这天是法定休息日。"
'Exit Sub
'End If
   
    
 Dim iZQ As Integer       ''''周期
 Dim bgD As Date
 bgD = adoPrimaryRS3.Fields("bgdate").Value
 iZQ = adoPrimaryRS3.Fields("wktmdays").Value
' Debug.Print adoPrimaryRS3.RecordCount
 
 
 Dim ii As Integer
 ii = DateDiff("d", bgD, tmpDate) Mod iZQ
' If ii = 0 Then
' MsgBox "请先设置好班次。"
' Exit Sub
' End If
ii = ii + 1
 
 adoPrimaryRS3.Filter = "regualorder=" & ii
            
            Dim bgnwktm1 As Date
            Dim bgnwktm1END 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
            

                        bgnwktm1 = tmpDate & " " & Mid(tmpTime, 11)
                       bgnwktm1END = DateAdd("d", 1, bgnwktm1)
                       
                       bgntm1 = Mid(IIf(IsNull(adoPrimaryRS3.Fields("bgntm1").Value), Now, adoPrimaryRS3.Fields("bgntm1").Value), 11)
                       endtm1 = Mid(IIf(IsNull(adoPrimaryRS3.Fields("endtm1").Value), Now, adoPrimaryRS3.Fields("endtm1").Value), 11)
                       bgntm2 = Mid(IIf(IsNull(adoPrimaryRS3.Fields("bgntm2").Value), Now, adoPrimaryRS3.Fields("bgntm2").Value), 11)
                       endtm2 = Mid(IIf(IsNull(adoPrimaryRS3.Fields("endtm2").Value), Now, adoPrimaryRS3.Fields("endtm2").Value), 11)
                        'endtm1 = Mid(adoPrimaryRS3.Fields("endtm1").Value, 11)
                        'bgntm2 = Mid(adoPrimaryRS3.Fields("bgntm2").Value, 11)
                        'endtm2 = Mid(adoPrimaryRS3.Fields("endtm2").Value, 11)
                        
                        
                        'endwktm1 = Mid(adoPrimaryRS3.Fields("endwktm1").Value, 11)
    
                        'bgnwktm2 = Mid(adoPrimaryRS3.Fields("bgnwktm2").Value, 11)
                        'endwktm2 = Mid(adoPrimaryRS3.Fields("endwktm2").Value, 11)
    
                        'bgnwktm3 = Mid(adoPrimaryRS3.Fields("bgnwktm3").Value, 11)
                        'bgntm3 = Mid(adoPrimaryRS3.Fields("bgntm3").Value, 11)
                        'endtm3 = Mid(adoPrimaryRS3.Fields("endtm3").Value, 11)
                        'endwktm3 = Mid(adoPrimaryRS3.Fields("endwktm3").Value, 11)
  
'Dim standwktm As Single
standwktm = (DateDiff("n", bgntm1, endtm1) + DateDiff("n", bgntm2, endtm2)) / 60
  
    
   
    
    
    
    
    
    
    
    
    
    
    
    
'        ltmp = oMenu.Popup(zgxm & "--请假", zgxm & "--出差", zgxm & "--调休", zgxm & "--特殊原因", "-", zgxm & "--漏刷卡", zgxm & "--无原因", "-", zgxm & "--原始考勤")
   
   
        If Option2(1).Value And Option1(0).Value And DTPicker1(0).Value = DTPicker1(1).Value And DataCombo1.Text = "" Then
          ltmp = oMenu.Popup(zgxm & "--不参与核算", zgxm & "--原始考勤", "停电特别处理")      '''', zgxm & "--出差", zgxm & "--调休", zgxm & "--特殊原因", "-", zgxm & "--漏刷卡", zgxm & "--无原因", "-", zgxm & "--原始考勤")
       Else
        ltmp = oMenu.Popup(zgxm & "--不参与核算", zgxm & "--原始考勤")       '''', zgxm & "--出差", zgxm & "--调休", zgxm & "--特殊原因", "-", zgxm & "--漏刷卡", zgxm & "--无原因", "-", zgxm & "--原始考勤")
        End If
        
        
        
        
        Select Case ltmp
            Case 1
         If MsgBox("请确认！？", vbYesNo) = vbYes Then
            strSQL = "delete from emplytp where emplyid='" & zggh & "'"
            mDB.ExecuteSQL strSQL
            If MsgBox("取消本月已核算结果吗？", vbYesNo) = vbYes Then
            Dim tD As Date
            Dim tD2 As Date
            tD = DateSerial(Year(tmpDate), Month(tmpDate), 1)
            tD2 = DateAdd("m", 1, tD) - 1
            
            strSQL = "delete from wktmrslt where  emplyid='" & zggh & "' and caldate between '" & tD & "' and '" & tD2 & "'"
            mDB.ExecuteSQL strSQL
            End If
      Toolbar1_ButtonClick Toolbar1.Buttons(3)
      End If
      
      
      
      
      
        Case 2
                strSQL = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid and emply.emplyid='" & zggh & "' and cdatetime between '" & bgnwktm1 & "' and '" & bgnwktm1END & "'"         '' order by empcrdtm.emplyid,cdatetime"
                Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
                Debug.Print adoprimaryRS.RecordCount
                Dim frmY As New NM_Bas
                With frmY
                    .Caption = zgxm & tmpDate & "--原始考勤记录"
                    .reload_datagrid adoprimaryRS
                    .Show vbModal
                End With
                Set frmY = Nothing
        
        Case 3
        
        Dim frmX As New frm_Kao_Tingdian
        With frmX
            .Show vbModal
            If .bOK Then
            .Hide
            strSQL2 = "select * from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(0).Value & "' and (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0)"           ''' or isnull(nCount,0)%2<>0) "
'  Debug.Print strSQL2
  
            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            
            
            adoPrimaryRS2.MoveFirst
            Do While Not adoPrimaryRS2.EOF
            
            'Dim tLaterEarly As Single
            Dim tLaterEarly2 As Single
    
            If adoPrimaryRS2.Fields("nCount").Value Then
             
             tLaterEarly = adoPrimaryRS2.Fields("latertime1").Value + adoPrimaryRS2.Fields("latertime2").Value + adoPrimaryRS2.Fields("earlytime1").Value + adoPrimaryRS2.Fields("earlytime2").Value
             
             
            
            If .Option1(0).Value Then
            adoPrimaryRS2.Fields("drawtmbg1").Value = DTPicker1(0).Value & " " & .SETIMER1(0).Text
            If adoPrimaryRS2.Fields("latertime1").Value = 0 Then
            adoPrimaryRS2.Fields("wktmrslt_flag").Value = adoPrimaryRS2.Fields("wktmrslt_flag").Value + 1
            Else
            tLaterEarly2 = adoPrimaryRS2.Fields("latertime1").Value
            End If
            adoPrimaryRS2.Fields("latertime1").Value = 0
            
            
            ElseIf .Option1(1).Value Then
            adoPrimaryRS2.Fields("drawtmend1").Value = DTPicker1(0).Value & " " & .SETIMER1(1).Text
            If adoPrimaryRS2.Fields("earlytime1").Value = 0 Then
            adoPrimaryRS2.Fields("wktmrslt_flag").Value = adoPrimaryRS2.Fields("wktmrslt_flag").Value + 1
             Else
            tLaterEarly2 = adoPrimaryRS2.Fields("earlytime1").Value
           End If
            adoPrimaryRS2.Fields("earlytime1").Value = 0
            
            ElseIf .Option1(2).Value Then
            adoPrimaryRS2.Fields("drawtmbg2").Value = DTPicker1(0).Value & " " & .SETIMER1(2).Text
            If adoPrimaryRS2.Fields("latertime2").Value = 0 Then
            adoPrimaryRS2.Fields("wktmrslt_flag").Value = adoPrimaryRS2.Fields("wktmrslt_flag").Value + 1
            Else
            tLaterEarly2 = adoPrimaryRS2.Fields("latertime2").Value
            End If
            adoPrimaryRS2.Fields("latertime2").Value = 0
            
            ElseIf .Option1(3).Value Then
            adoPrimaryRS2.Fields("drawtmend2").Value = DTPicker1(0).Value & " " & .SETIMER1(3).Text
            If adoPrimaryRS2.Fields("earlytime2").Value = 0 Then
            adoPrimaryRS2.Fields("wktmrslt_flag").Value = adoPrimaryRS2.Fields("wktmrslt_flag").Value + 1
            Else
            tLaterEarly2 = adoPrimaryRS2.Fields("earlytime2").Value
            End If
            adoPrimaryRS2.Fields("earlytime2").Value = 0
            
            End If
            
            Dim iWork As Single
            '''adoPrimaryRS2.Fields("datwktm").Value = adoPrimaryRS2.Fields("standwktm").Value - adoPrimaryRS2.Fields("latetime2").Value - adoPrimaryRS2.Fields("earlytime1").Value - adoPrimaryRS2.Fields("earlytime2").Value
            iWork = adoPrimaryRS2.Fields("standwktm").Value - Round((tLaterEarly - tLaterEarly2) / 60, 1)
            If adoPrimaryRS2.Fields("workwktm").Value < iWork Then
            adoPrimaryRS2.Fields("workwktm").Value = iWork
            ''''adoPrimaryRS2.Fields("workwktm").Value = adoPrimaryRS2.Fields("datwktm").Value
            End If
            If iWork - adoPrimaryRS2.Fields("standwktm").Value < 0.15 Then
            adoPrimaryRS2.Fields("wktmflag").Value = 1            '''' 是否异常     '''1=正常；0=异常；

         adoPrimaryRS2.Fields("wktmrslt_flag").Value = 7           '''是否异常     ''''XXXXX1 旷工2请假3出差4调休 5休息6假日加班7正常8异常9休日加班10病假11事假12婚假13请假4
            End If
            adoPrimaryRS2.Fields("datwktm").Value = iWork
            
            iWork = 0
            tLaterEarly = 0
            tLaterEarly2 = 0
            
            
            adoPrimaryRS2.Update
            End If
            adoPrimaryRS2.MoveNext
            Loop
            
            MsgBox "恭喜你，处理完毕"
                        Toolbar1_ButtonClick Toolbar1.Buttons(3)

            End If
        End With
        
        
        
        
        
        
        
        
        
        
        
'            Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'                With Frm_Kao_holiday
'                    .txtFields(0).Text = DataGrid1.Columns(0).Text
'                    .txtFields(1).Text = DataGrid1.Columns(1).Text
'                    .Check1 = 1
'                    .DTPicker1(0).Value = DataGrid1.Columns(2).Text
'                    .DTPicker1(1).Value = DataGrid1.Columns(2).Text
'                    '.txtFields(2).Text = DataGrid1.Columns(0).Text
'                   Set .DataCombo1(0).RowSource = adoprimaryRS
'                   .DataCombo1(0).BoundColumn = "holidayid"
'                   .DataCombo1(0).ListField = "holidaydecs"
'                   .DataCombo1(0).Refresh
'
'                    .txtFields(3).Text = UserName
'                    .Show vbModal
'                End With
            
'            Case 2
'            strSQL = "select evectionid,evectiondecs from evectionkind"
'            Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'                With Frm_Kao_Evection
'                    .txtFields(0).Text = DataGrid1.Columns(0).Text
'                    .txtFields(1).Text = DataGrid1.Columns(1).Text
'                    .Check1 = 1
'                    .DTPicker1(0).Value = DataGrid1.Columns(2).Text
'                    .DTPicker1(1).Value = DataGrid1.Columns(2).Text
'                    '.txtFields(2).Text = DataGrid1.Columns(0).Text
'                   Set .DataCombo1(0).RowSource = adoprimaryRS
'                   .DataCombo1(0).BoundColumn = "evectionid"
'                   .DataCombo1(0).ListField = "evectiondecs"
'                   .DataCombo1(0).Refresh
'
'                    .txtFields(3).Text = UserName
'                    .Show vbModal
'                End With
'
'            Case 3
'               With sForm
'                .GetFindV2 "请输入原因备注和调休工时：", "调休原因：", "调休工时："
'                sTmp = .GetFindVar1
'                iHour = Val(.GetFindVar2)
'                End With
'
'                If sTmp <> "" Then
'                strSQL = "insert into Yuanyin(emplyid,yuanyinLX,Djdate,hours,ratifier,makeid,bzsm) values('" & DataGrid1.Columns(0).Text & "','调休','" & DataGrid1.Columns(2).Text & "'," & iHour & ",'" & UserName & "','" & OperID & "','" & sTmp & "')"
'                mDB.ExecuteSQL strSQL
'        strSQL = "update wktmrslt set QueRen=3 where emplyid='" & DataGrid1.Columns(0).Text & "' and caldate='" & DataGrid1.Columns(2).Text & "'"
'      mDB.ExecuteSQL strSQL
'      Toolbar1_ButtonClick Toolbar1.Buttons(3)
'                Else
'
'                Exit Sub
'                End If
'            Case 4
'               With sForm
'                .GetFindV2 "请输入特殊原因备注和工时：", "特殊原因：", "工时："
'                sTmp = .GetFindVar1
'                iHour = Val(.GetFindVar2)
'                End With