frm_kaoqihesuan2.frm

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

            '            'strSQL3 = "update j_fac set ifx=true where fac_id=" & Val(Left(list1(1).List(i), InStr(list1(1).List(i), ",") - 1))
            '            strSQL3 = "update gongxu set flg=false where htcode='" & DataCombo1.Text & "' and  htcode_pro='" & Left(List1(1).List(i), InStr(List1(1).List(i), ",") - 1) & "'"
            '            mDB.ExecuteSQL strSQL3

            '' List1.RemoveItem List1.List(i)
            judgeList List2, List1.List(i)
            stmp = stmp & "'" & List1.List(i) & "',"
            'List12.AddItem List1.List(i)
            'List2.Selected(List2.ListCount - 1) = True


        End If
    Next i
    stmp = Left(stmp, Len(stmp) - 1)
   
            
    '            'For i = 0 To List1.ListCount - 1    ''' To 0 Step -1
    '          For i = List1.ListCount - 1 To 0 Step -1
    '                If List1.Selected(i) = True Then
    '                'If InStr(sTmp, List1.List(i)) Then
    '                    ''Debug.Print Val(Left(list1(0).List(I), InStr(list1(0).List(I), ",") - 1))
    '                    'strSQL3 = "update j_fac set ifx=false where fac_id=" & Val(Left(List1(0).List(i), InStr(List1(0).List(i), ",") - 1))
    '                    'mDB.ExecuteSQL strSQL3
    '                    ''List1(1).AddItem List1(0).List(i)
    '
    '                    'List1.Selected(i) = False
    '
    '                    'List1.RemoveItem List1.List(i)
    '                    List1.RemoveItem List1.ListIndex
    '
    '
    '                End If
    '            Next i
    List1.Clear
    For i = 0 To nCount
        If InStr(stmp, "'" & sList(i) & "'") Then
        Else
            List1.AddItem sList(i)
        End If
    Next i


    '    DataCombo1_Click 2


    'Reload_PrimaryRS 1
End Sub

Private Sub cmdright_Click()
    '   Dim i As Integer
    '    On Error Resume Next
    '
    '    For i = 0 To List2.ListCount - 1
    '        If List2.Selected(i) = True Then
    '            judgeList List1, List2.List(i)
    '            'List1.Selected(List1.ListCount - 1) = True
    '        End If
    '    Next i
    '
    '    For i = List2.ListCount - 1 To 0 Step -1
    '        If List2.Selected(i) = True Then
    '        List2.Selected(i) = False
    '            List2.RemoveItem List2.ListIndex
    '        End If
    '    Next i

    Dim i As Integer
    On Error Resume Next
    Dim stmp As String
    
    Dim nCount As Integer
    nCount = List2.ListCount - 1
    Dim sList() As String
    ReDim sList(nCount)

    For i = 0 To List2.ListCount - 1
        sList(i) = List2.List(i)
        If List2.Selected(i) = True Then
            judgeList List1, List2.List(i)
            stmp = stmp & "'" & List2.List(i) & "',"
        End If
    Next i
    stmp = Left(stmp, Len(stmp) - 1)
   

    List2.Clear
    For i = 0 To nCount
        If InStr(stmp, "'" & sList(i) & "'") Then
        Else
            List2.AddItem sList(i)
        End If
    Next i


End Sub




Private Sub DTPicker1_CloseUp(Index As Integer)
    Select Case Index
        Case 0
            Dim d As Date
            d = DateAdd("m", 1, DTPicker1(0).Value)
            'DTPicker1(1).Value = DateSerial(Year(d), Month(d), 1) - 1
            DTPicker1(1).Value = DTPicker1(0).Value
    End Select


End Sub

Private Sub Form_Load()
    Screen.MousePointer = vbHourglass

    'strConn = SQLcon
    'strConn0 = SQLcon0

    Set mDB = New mDB
    mDB.InitDB_RY strconnDR

    'Debug.Print strconnDR


    strSQL = "select dptid,dptname from depart where ify=1 order by dptname asc"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    'Debug.Print adoprimaryRS.RecordCount

    '    With DataCombo1(0)
    '        Set .RowSource = adoprimaryRS
    '        .BoundColumn = "dptid"
    '        .ListField = "dptname"
    '        .Refresh
    '    End With

    With adoprimaryRS
        .MoveFirst
        Do Until .EOF
            List1.AddItem .Fields("dptname").Value
            .MoveNext
        Loop
    End With

    '    strSQL = "select max(cdatetime) as maxdate from empcrdtm" '' order by begdate asc"
    '    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    '    DTPicker1(0).Value = Format(adoprimaryRS.Fields("maxdate").Value + 1, "yyyy-mm-dd") ''' Date
    '    '  DTPicker1(1).Value = Date
    '    '  Option1(0).Value = True
    '    '  SETIMER1(0).Text = "00:00:01"
    '    '  SETIMER1(1).Text = "23:59:59"

  
    '      strSQL = "select * from wktm2" '' order by begdate asc"
    strSQL = "select * from wktm where wktmid=2"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)

    '    SETIMER1(0).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm1").Value), Minute(adoprimaryRS("bgnwktm1").Value), 0) '''' "00:00:01"
    '    SETIMER1(1).Text = TimeSerial(Hour(adoprimaryRS("bgntm1").Value), Minute(adoprimaryRS("bgntm1").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(2).Text = TimeSerial(Hour(adoprimaryRS("endtm1").Value), Minute(adoprimaryRS("endtm1").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(3).Text = TimeSerial(Hour(adoprimaryRS("endwktm1").Value), Minute(adoprimaryRS("endwktm1").Value), 0) '''' "00:00:01"
    '    SETIMER1(4).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm2").Value), Minute(adoprimaryRS("bgnwktm2").Value), 0) '''' "00:00:01"
    '    SETIMER1(5).Text = TimeSerial(Hour(adoprimaryRS("bgntm2").Value), Minute(adoprimaryRS("bgntm2").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(6).Text = TimeSerial(Hour(adoprimaryRS("endtm2").Value), Minute(adoprimaryRS("endtm2").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(7).Text = TimeSerial(Hour(adoprimaryRS("endwktm2").Value), Minute(adoprimaryRS("endwktm2").Value), 0) '''' "00:00:01"
    '    SETIMER1(8).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm3").Value), Minute(adoprimaryRS("bgnwktm3").Value), 0) '''' "00:00:01"
    '    SETIMER1(9).Text = TimeSerial(Hour(adoprimaryRS("bgntm3").Value), Minute(adoprimaryRS("bgntm3").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(10).Text = TimeSerial(Hour(adoprimaryRS("endtm3").Value), Minute(adoprimaryRS("endtm3").Value), 0) '''' "00:00:01""23:59:59"
    '    SETIMER1(11).Text = TimeSerial(Hour(adoprimaryRS("endwktm3").Value), Minute(adoprimaryRS("endwktm3").Value), 0) '''' "00:00:01"
    CenterForm Me
    '  Debug.Print DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text)

    '''''''将人员表数据导入sqlserver数据库
    ''strSQL2 = "delete from emply2"
    ''Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
    ''''''''''***********************************一定要是ACCESS等桌面数据库，绝对位置，单引号***********************************
    ''    Dim MD As New mDB
    ''    MD.InitDB
    ''    strSQL = "select * into emppp in 'e:\sjk\data\hisdata1.mdb'  from emply2"
    '''    adoprimaryRS.Save emp.rst
    ''MD.MakeTables strSQL, "emppp"
    ''''
    ''strSQL = "select * from emppp"
    ''MD.CreateRS adoprimaryRS, strSQL
    ''''''''''**********************************************************************
    ''Debug.Print adoprimaryRS.RecordCount

    ''
    ''strSQL2 = "select * from emply2"
    ''Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
    ''With adoprimaryRS
    ''    .MoveFirst
    ''Do Until .EOF
    ''    adoPrimaryRS2.AddNew
    ''    adoPrimaryRS2.Fields("ifin").Value = .Fields("ifin").Value
    ''    adoPrimaryRS2.Fields("partname").Value = .Fields("partname").Value
    ''    adoPrimaryRS2.Fields("emplyid").Value = "00" & .Fields("emplyid").Value
    ''    adoPrimaryRS2.Fields("emplyname").Value = .Fields("emplyname").Value
    ''    adoPrimaryRS2.Fields("indate").Value = .Fields("indate").Value
    ''    adoPrimaryRS2.Fields("outdate").Value = .Fields("outdate").Value
    ''    adoPrimaryRS2.Fields("gangwei").Value = .Fields("gangwei").Value
    ''    adoPrimaryRS2.Update
    ''    .MoveNext
    ''Loop
    ''End With
    ''Set MD = Nothing

    'strSQL = "select dptname as 部门,emplyid as 工号,emplyname as 姓名,serial as 卡序列号 from depart,emply where depart.dptid=emply.dptid"
    '
    'Dim o As New ToExcel
    ''strSQL = "select * from emply where emplyid not in (select emplyid from emply2)"
    'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    'Debug.Print adoprimaryRS.RecordCount
    'o.ToExcel adoprimaryRS, "不匹配", "不在新表中"
    '
    'strSQL = "select * from emply2 where emplyid not in (select emplyid from emply)"
    'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    'Debug.Print adoprimaryRS.RecordCount
    'o.ToExcel adoprimaryRS, "不匹配", "不在表中"
    'Set o = Nothing
    '

    strSQL = "select * from emply"    ''''2 where emplyid not in (select emplyid from emply)"
    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
    
    
    Dim d As Date
    d = DateAdd("m", -1, Date)
    DTPicker1(0).Value = DateSerial(Year(d), Month(d), 1)
    DTPicker1(1).Value = DateSerial(Year(Date), Month(Date), 1) - 1

    ProgressBar1.Value = 0
    ProgressBar1.Max = 100
End Sub


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