frm_rpt_kaoqin.frm

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

            '
            '    SpFlg = False
            '
            '
            '    ElseIf adoprimaryRS.Fields("HeFlg3").Value <> 0 Then
            '    Check1(0).Value = 1
            '    Label3(0).Caption = "已审批"
            '
            '    Check1(1).Value = 0
            '    Label3(3).Caption = "未结算"
            '    Toolbar1.Buttons(1).Enabled = False
            '    Toolbar1.Buttons(2).Enabled = False
            '    Toolbar1.Buttons(4).Enabled = False
            '
            '    SpFlg = False
            '
            '
            '    Else
            '
            '    Check1(0).Value = 0
            '    Label3(0).Caption = "待审批"
            '    Check1(1).Value = 0
            '    Label3(3).Caption = "未结算"
            '    Toolbar1.Buttons(1).Enabled = True
            '    Toolbar1.Buttons(2).Enabled = True
            '    Toolbar1.Buttons(4).Enabled = True
            '
            '    SpFlg = True
            '
            '    End If
            '
            '
            '
            '
            '
            'Else
            '
            '    Check1(0).Value = 0
            '    Label3(0).Caption = "待审批"
            '    Check1(1).Value = 0
            '    Label3(3).Caption = "未结算"
            '    Toolbar1.Buttons(1).Enabled = True
            '    Toolbar1.Buttons(2).Enabled = True
            '    Toolbar1.Buttons(4).Enabled = True
            '
            '    SpFlg = True
            '
            '
            'End If
            '
            'strSQL4 = "select ID,iYear,iMonth,emplyid,emplyname,iFen,iDay from NM_ZaGong where iYear=" & Combo1(0).Text & " and iMonth=" & Combo1(1).Text
            'Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)
            '
            '
            'Reload_DataGrid
'            Dim strSQL4 As String * 4000

            If Option2(0).Value Then
                If Option1(0).Value And DataCombo1.Text = "" Then
                    '''strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "wktmrslt_flag as 出勤情况  from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "'"
'                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "'"
                     strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid  where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "'"
               ElseIf Option1(0).Value And DataCombo1.Text <> "" Then
                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and dptid=" & DataCombo1.BoundText
                ElseIf Option1(1).Value And Text1.Text <> "" Then
                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid='" & Text1.Text & "'"
                ElseIf Option1(1).Value And Text1.Text = "" Then
                    MsgBox "个人资料不能为空。"
                    Exit Sub
                End If
'                If Option1(0).Value And DataCombo1.Text = "" Then
'                    '''strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "wktmrslt_flag as 出勤情况  from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "'"
'                    strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid  where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "'"
'                ElseIf Option1(0).Value And DataCombo1.Text <> "" Then
'                    strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and dptid=" & DataCombo1.BoundText
'                ElseIf Option1(1).Value And Text1.Text <> "" Then
'                    strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid   where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid='" & Text1.Text & "'"
'                ElseIf Option1(1).Value And Text1.Text = "" Then
'                    MsgBox "个人资料不能为空。"
'                    Exit Sub
'                End If
'                IniFunc.writeINI App.Path & "\aaa.ini", "a", "a", strSQL4

            Else      ''''异常；
                '    If Option1(0).Value And DataCombo1.Text = "" Then
                '    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and wktmflag=0"
                '    ElseIf Option1(0).Value And DataCombo1.Text <> "" Then
                '    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and dptid=" & DataCombo1.BoundText & " and wktmflag=0"
                '    ElseIf Option1(1).Value And Text1.Text <> "" Then
                '    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid='" & Text1.Text & "' and wktmflag=0"
                '    ElseIf Option1(1).Value And Text1.Text = "" Then
                '    MsgBox "个人资料不能为空。"
                '    Exit Sub
                '    End If

                If Option1(0).Value And DataCombo1.Text = "" Then
'                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0)"           ''' or isnull(nCount,0)%2<>0) "
                    strSQL4 = "select b.partname as 部门,b.emplyid as 工号,b.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt a left join wkrslt c on a.wktmrslt_flag=c.ID inner join emply2 b  on b.emplyid=a.emplyid "
                    strSQL4 = strSQL4 & " where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0) and QueRen<1"           ''' or isnull(nCount,0)%2<>0) "
                ElseIf Option1(0).Value And DataCombo1.Text <> "" Then
                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and dptid=" & DataCombo1.BoundText & " and  (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0) and QueRen<1"           ''' or isnull(nCount,0)%2<>0) "
                ElseIf Option1(1).Value And Text1.Text <> "" Then
                    strSQL4 = "select emplyid as 工号,emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid='" & Text1.Text & "' and  (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0) and QueRen<1"           ''' or isnull(nCount,0)%2<>0) "
                ElseIf Option1(1).Value And Text1.Text = "" Then
                    MsgBox "个人资料不能为空。"
                    Exit Sub
                End If
'                If Option1(0).Value And DataCombo1.Text = "" Then
'                    strSQL4 = "select b.partname as 部门,b.emplyid as 工号,b.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt a left join wkrslt c on a.wktmrslt_flag=c.ID inner join emply2 b  on b.emplyid=a.emplyid "
'                    strSQL4 = strSQL4 & " where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0)"           ''' or isnull(nCount,0)%2<>0) "
'                ElseIf Option1(0).Value And DataCombo1.Text <> "" Then
''                    strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid"
'                    strSQL4 = "select b.partname as 部门,b.emplyid as 工号,b.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt a left join wkrslt c on a.wktmrslt_flag=c.ID inner join emply2 b  on b.emplyid=a.emplyid "
'                    strSQL4 = strSQL4 & " where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and dptid=" & DataCombo1.BoundText & " and  (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0)"         ''' or isnull(nCount,0)%2<>0) "
'                ElseIf Option1(1).Value And Text1.Text <> "" Then
'                    strSQL4 = "select emply2.partname as 部门,emply2.emplyid as 工号,emply2.emplyname as 姓名,caldate as 日期," & sFldString & "DesCrip as 出勤情况  from wktmrslt left join wkrslt on wktmrslt.wktmrslt_flag=wkrslt.ID inner join emply2  on emply2.emplyid=wktmrslt.emplyid "
'                    strSQL4 = strSQL4 & " where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid='" & Text1.Text & "' and  (wktmflag=0 or latertime1>0 or earlytime1>0  or latertime2>0 or earlytime2>0)"           ''' or isnull(nCount,0)%2<>0) "
'                ElseIf Option1(1).Value And Text1.Text = "" Then
'                    MsgBox "个人资料不能为空。"
'                    Exit Sub
'                End If
            End If
'Dim i As Integer
'i = Len(strSQL4)
'            Debug.Print strSQL4
            

            Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)
            Debug.Print adoprimaryRS4.RecordCount
            
            With DataGrid1
                .ClearFields
                .DefColWidth = 900
                Set .DataSource = adoprimaryRS4
                '    .Columns(0).DataField = "ID"
                '    .Columns(1).DataField = "iYear"
                '    .Columns(2).DataField = "iMonth"
                '    .Columns(3).DataField = "emplyID"
                '    .Columns(4).DataField = "emplyName"
                '    .Columns(5).DataField = "iFen"
                '    .Columns(6).DataField = "iDay"
                '        .Columns(3).Locked = True
                '        .Columns(4).Locked = True
                '    .Columns(0).width = 0
                '    .Columns(1).width = 0
                .Columns(0).width = 2500
                .Columns(3).width = 1000
                ''    .Columns(3).width = 0
                '    .Columns(3).Caption = "工号"
                '    .Columns(4).Caption = "姓名"
                '    .Columns(5).Caption = "评分"
                '    .Columns(6).Caption = "工作天数"
                .Refresh
            End With


        Case 4
            Screen.MousePointer = 11
            ToExcel.ToExcel adoprimaryRS4
            Screen.MousePointer = 0
        Case 5
            Unload Me


   


    End Select

    Exit Sub

Err1:
    MsgBox Err.Number & "," & Err.Description

End Sub

Private Sub reload_datagrid()
    'strSQL4 = "select ID,iYear,iMonth,emplyid,emplyname,iFen,iDay from NM_ZaGong where iYear=" & Combo1(0).Text & " and iMonth=" & Combo1(1).Text & " and ID=" & DataList1.BoundText
    'Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)
    'Debug.Print strSQL4
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS4
        .Columns(0).DataField = "ID"
        .Columns(1).DataField = "iYear"
        .Columns(2).DataField = "iMonth"
        .Columns(3).DataField = "emplyID"
        .Columns(4).DataField = "emplyName"
        .Columns(5).DataField = "iFen"
        .Columns(6).DataField = "iDay"
        .Columns(3).Locked = True
        .Columns(4).Locked = True
        .Columns(0).width = 0
        .Columns(1).width = 0
        .Columns(2).width = 0
        '    .Columns(3).width = 0
        .Columns(3).Caption = "工号"
        .Columns(4).Caption = "姓名"
        .Columns(5).Caption = "评分"
        .Columns(6).Caption = "工作天数"
        .Refresh
    End With
    If SpFlg Then
        DataGrid1.AllowUpdate = True
    Else
        DataGrid1.AllowUpdate = False
    End If

End Sub




Private Function GetSqlString() As String

    Dim mDB As mDB
    Dim strSQL As String
    Dim adoprimaryRS As ADODB.Recordset
    Dim strSQL2 As String
    Dim adoPrimaryRS2 As ADODB.Recordset
    Set mDB = New mDB
    mDB.InitDB_RY strconnDR

    Dim stmp As String


    strSQL = "select * from wktmrslt_report"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    If adoprimaryRS.RecordCount Then
        With adoprimaryRS
            If .Fields("wktmbg1").Value Then
                'sTmp = sTmp & "wktmbg1 as 上班时间1,"
                stmp = stmp & "(CASE WHEN wktmbg1 < 1 THEN '' ELSE substring(cast(wktmbg1 as char(22)),11,8) end) as 上班时间1,"
            End If
            If .Fields("drawtmbg1").Value Then
                'sTmp = sTmp & "drawtmbg1 as 上班刷卡1,"
                stmp = stmp & "(case when drawtmbg1<1 then '' else substring(cast(drawtmbg1 as char(22)),11,8) end) as 上班刷卡1,"
            End If
            If .Fields("latertime1").Value Then
                stmp = stmp & "latertime1 as 迟到时间1,"
            End If
            If .Fields("wktmbg1dec").Value Then
                stmp = stmp & "wktmbg1dec as 上班描述1,"
            End If
            If .Fields("wktmend1").Value Then
                'sTmp = sTmp & "wktmend1 as 下班时间1,"
                stmp = stmp & "(CASE WHEN wktmend1 < 1 THEN '' ELSE substring(cast(wktmend1 as char(22)),11,8) end) as 下班时间1,"
            End If
            If .Fields("drawtmend1").Value Then
                'sTmp = sTmp & "drawtmend1 as 下班刷卡1,"
                stmp = stmp & "(CASE WHEN drawtmend1 < 1 THEN '' ELSE substring(cast(drawtmend1 as char(22)),11,8) end) as 下班刷卡1,"
            End If
            If .Fields("earlytime1").Value Then
                stmp = stmp & "earlytime1 as 早退时间1,"
            End If
            If .Fields("wktmend1dec").Value Then
                stmp = stmp & "wktmend1dec as 下班描述1,"
            End If
       
            If .Fields("wktmbg2").Value Then
                'sTmp = sTmp & "wktmbg2 as 上班时间2,"
                stmp = stmp & "(CASE WHEN wktmbg2 < 1 THEN '' ELSE substring(cast(wktmbg2 as char(22)),11,8) end) as 上班时间2,"
            End If
            If .Fields("drawtmbg2").Value Then
                'sTmp = sTmp & "drawtmbg2 as 上班刷卡2,"
                stmp = stmp & "(CASE WHEN drawtmbg2 < 1 THEN '' ELSE substring(cast(drawtmbg2 as char(22)),11,8) end) as 上班刷卡2,"
            End If
            If .Fields("latertime2").Value Then
                stmp = stmp & "latertime2 as 迟到时间2,"
            End If
            If .Fields("wktmbg2dec").Value Then
                stmp = stmp & "wktmbg2dec as 上班描述2,"
            End If
            If .Fields("wktmend2").Value Then
                'sTmp = sTmp & "wktmend2 as 下班时间2,"
                stmp = stmp & "(CASE WHEN wktmend2 < 1 THEN '' ELSE substring(cast(wktmend2 as char(22)),11,8) end) as 下班时间2,"
            End If
            If .Fields("drawtmend2").Value Then
                'sTmp = sTmp & "drawtmend2 as 下班刷卡2,"
                stmp = stmp & "(CASE WHEN drawtmend2 < 1 THEN '' ELSE substring(cast(drawtmend2 as char(22)),11,8) end) as 下班刷卡2,"
            End If
            If .Fields("earlytime2").Value Then
                stmp = stmp & "earlytime2 as 早退时间2,"
            End If
            If .Fields("wktmend2dec").Value Then
                stmp = stmp & "wktmend2dec as 下班描述2,"
            End If
       
            If .Fields("wktmbg3").Value Then
                'sTmp = sTmp & "wktmbg3 as 上班时间3,"
                stmp = stmp & "(CASE WHEN wktmbg3 < 1 THEN '' ELSE substring(cast(wktmbg3 as char(22)),11,8) end) as 上班时间3,"
            End If
            If .Fields("drawtmbg3").Value Then
                'sTmp = sTmp & "drawtmbg3 as 上班刷卡3,"
                stmp = stmp & "(CASE WHEN drawtmbg3 < 1