frm_rndtimecard.frm

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

    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)




    Debug.Print adoprimaryRS.RecordCount

    'Dim m_sConnect As String
    'm_sConnect = "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=z:\data\hisdata1.mdb;Jet OLEDB:Database Password=notopen;" '''''用的是ODBC驱动程序
    '
    'strSQL = "select * into emplyww in """ & m_sConnect & """  from emply2 where outdate is null"    ''''2 where emplyid not in (select emplyid from emply)"
    'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    'Database_Refresh 0
    'Debug.Print strSQL
    '
    
    Screen.MousePointer = 0
    
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Screen.MousePointer = vbDefault
  
End Sub








Private Sub GurhanButton1_Click(Index As Integer)


    On Error GoTo Err1


    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)

    'bgtm = DTPicker1(0).Value & " " & SETIMER1(0).Text
    't1 = DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text)
    'Debug.Print bgtm
    'Debug.Print t1




    Select Case Index
        Case 0


            strSQL2 = "delete from emplytmp"
            mDB.ExecuteSQL strSQL2
            Dim s As String

            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) & "'"
            s = "select emplyid,serial from emply,depart where  depart.dptid=emply.dptid and emply.empcrdyn=1 and dptname ='" & List1.List(i) & "'"
            Debug.Print s

                Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            Next i

            'GurhanButton1(0).BackColor = vbBlue
            'GurhanButton1(0).BackColor = &H8000000F

            'Dim mancount As Integer
            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
            
            strSQL = "delete from emplytp where serial is null or len(rtrim(serial))<1"
            'strSQL = "update emplytp set serial='7788' where serial is null or len(rtrim(serial))<1"
            mDB.ExecuteSQL strSQL
            
            '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 c.dptname,b.emplyname, a.emplyid,a.serial from emplytp a,emply b,depart c where a.emplyid=b.emplyid and b.dptid=c.dptid and (outdate is null) or (outdate>'" & DTPicker1(0).Value & "')"

            'Debug.Print DTPicker1(0).Value
            'Debug.Print strSQL2

            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            If adoPrimaryRS2.RecordCount = 0 Then
                MsgBox "你所选择的部门无员工，请重新选择。谢谢。", vbOKOnly, "NewAsia"
                Exit Sub
            Else
            '''ToExcel.ToExcel adoPrimaryRS2
            
                MsgBox "共有" & mancount & "_" & adoPrimaryRS2.RecordCount & "人参与考勤", vbOKOnly, "NewAsia"
            End If

            Screen.MousePointer = 11


            bgtm = DTPicker1(0).Value & " " & SETIMER1(0).Text
            t1 = DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text)


            mDB.BeginTrans
            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 1
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop

            bgtm = DTPicker1(0).Value & " " & SETIMER1(6).Text
            t1 = DateDiff("n", SETIMER1(6).Text, SETIMER1(7).Text)



            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 0
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop
            mDB.CommitTrans
            Screen.MousePointer = 0
            MsgBox "ok!"

        Case 1




            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

            'GurhanButton1(0).BackColor = vbBlue
            'GurhanButton1(0).BackColor = &H8000000F

            'Dim mancount As Integer
            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
              
            
            strSQL = "delete from emplytp where serial is null or len(rtrim(serial))<1"
            mDB.ExecuteSQL strSQL
            
          '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 & "')"


           ' Debug.Print DTPicker1(0).Value
           ' Debug.Print strSQL2

            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            If adoPrimaryRS2.RecordCount = 0 Then
                MsgBox "你所选择的部门无员工，请重新选择。谢谢。", vbOKOnly, "NewAsia"
                Exit Sub
            Else
                MsgBox "共有" & mancount & "_" & adoPrimaryRS2.RecordCount & "人参与考勤", vbOKOnly, "NewAsia"
            End If

            Screen.MousePointer = 11



            bgtm = DTPicker1(0).Value & " " & SETIMER1(0).Text
            t1 = DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text)


            mDB.BeginTrans
            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 1
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop

            bgtm = DTPicker1(0).Value & " " & SETIMER1(2).Text
            t1 = DateDiff("n", SETIMER1(2).Text, SETIMER1(3).Text)


            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 0
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop



            bgtm = DTPicker1(0).Value & " " & SETIMER1(4).Text
            t1 = DateDiff("n", SETIMER1(4).Text, SETIMER1(5).Text)



            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 1
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop



            bgtm = DTPicker1(0).Value & " " & SETIMER1(6).Text
            t1 = DateDiff("n", SETIMER1(6).Text, SETIMER1(7).Text)



            adoPrimaryRS2.MoveFirst
            Do Until adoPrimaryRS2.EOF
                With adoprimaryRS
                    .AddNew
                    .Fields("crdtmid").Value = Maxid + 1
                    .Fields("emplyid").Value = adoPrimaryRS2.Fields("emplyid").Value
                    .Fields("empcrdno").Value = adoPrimaryRS2.Fields("serial").Value
                    .Fields("deviceid").Value = Int(Rnd * 2) + 1
                    .Fields("reasonid").Value = 0
                    .Fields("inorout").Value = 0
                    .Fields("cdatetime").Value = DateAdd("n", Int(t1 * Rnd) + 1, bgtm)
                    .Fields("isovertime").Value = 0
                    .Fields("recordtype").Value = 0
                    .Fields("operid").Value = "000001"
                    .Update
                End With
                Maxid = Maxid + 1
                adoPrimaryRS2.MoveNext
            Loop
            mDB.CommitTrans
            Screen.MousePointer = 0
            MsgBox "ok!"



            ''GurhanButton1(0).BackColor = &H8000000F
            ''GurhanButton1(1).BackColor = vbBlue
            'SQLtmp10.Show
        Case 2

            'Dim mancount As Integer
            strSQL2 = "delete from emplytmp"
            mDB.ExecuteSQL strSQL2


            For i = 0 To List1.ListCount - 1