modulemain.bas

考勤机管理软件,用于统计某段时间某个部门或者某个员工在某段内迟到与早退次数.

    
    End If
    
    
'==============SetVacInfo=================================
    ReDim SetVacTypeInfo(0)
    tmpRst.Close
    Set tmpRst = Nothing
    tmpRst.Open "select * from SetVac order by EmployeeID,TimePos,TimeMode", con, adOpenStatic, adLockReadOnly
    lCount = tmpRst.RecordCount
    
    If lCount > 0 Then

        ReDim SetVacTypeInfo(1 To lCount) As SetVacType
        blnSetVacTypeInfo = True
        
        tmpRst.MoveFirst
        For i = 1 To lCount
            SetVacTypeInfo(i).EmployeeID = tmpRst!EmployeeID
            
            If Trim(tmpRst!TimeMode) = "每天" Then
                SetVacTypeInfo(i).TimeMode = 0
            ElseIf Trim(tmpRst!TimeMode) = "每周" Then
                SetVacTypeInfo(i).TimeMode = 1
            ElseIf Trim(tmpRst!TimeMode) = "每月" Then
                SetVacTypeInfo(i).TimeMode = 2
            End If
            
            
            If tmpRst!TimePos = "全天" Then
                SetVacTypeInfo(i).TimePos = 0
            Else
                SetVacTypeInfo(i).TimePos = Val(Mid(tmpRst!TimePos, 4, Len(tmpRst!TimePos) - 3))
            End If
            
            SetVacTypeInfo(i).BeginDate = tmpRst!BeginDate
            SetVacTypeInfo(i).EndDate = tmpRst!EndDate
            SetVacTypeInfo(i).BeginTime = tmpRst!BeginTime
            SetVacTypeInfo(i).EndTime = tmpRst!EndTime
            tmpRst.MoveNext
        Next
    
    End If
 '============SetClassInfo==================================

    strSQL = " select * from setclass" _
         & " where  EndDate>= '" & sBeginTime & "' and BeginDate<='" & sEndTime & "'" _
         & " order by AddClass desc"
    ReDim SetClassInfo(0)
    tmpRst.Close
    Set tmpRst = Nothing
    tmpRst.Open strSQL, con, adOpenStatic, adLockReadOnly
    lCount = tmpRst.RecordCount
    
    If lCount > 0 Then
    
        ReDim SetClassInfo(1 To lCount) As SetClassType
        blnSetClassInfo = True
        
        tmpRst.MoveFirst
        For i = 1 To lCount
            
            SetClassInfo(i).EmployeeID = tmpRst!EmployeeID
            SetClassInfo(i).AddClass = tmpRst!AddClass
            SetClassInfo(i).BeginDate = tmpRst!BeginDate
            SetClassInfo(i).EndDate = tmpRst!EndDate
            
            
            If Trim(tmpRst!TimeMode) = "每天" Then
                SetClassInfo(i).TimeMode = 0
            ElseIf Trim(tmpRst!TimeMode) = "每周" Then
                SetClassInfo(i).TimeMode = 1
            ElseIf Trim(tmpRst!TimeMode) = "每月" Then
                SetClassInfo(i).TimeMode = 2
            End If

            tmps = tmpRst!BeginDate
            SetClassInfo(i).BeginDate = Val(Mid(tmps, 1, 4)) * 600 + Val(Mid(tmps, 6, 2)) * 50 + Val(Mid(tmps, 9, 2))
            tmps = tmpRst!EndDate
            SetClassInfo(i).EndDate = Val(Mid(tmps, 1, 4)) * 600 + Val(Mid(tmps, 6, 2)) * 50 + Val(Mid(tmps, 9, 2))
            
            If SetClassInfo(i).TimeMode <> 0 Then
            
                If IsNull(tmpRst!BeginTime) Or Trim(tmpRst!BeginTime) = "" Then SetClassInfo(i).BeginTime = 0 Else SetClassInfo(i).BeginTime = tmpRst!BeginTime
                If IsNull(tmpRst!EndTime) Or Trim(tmpRst!EndTime) = "" Then SetClassInfo(i).EndTime = 0 Else SetClassInfo(i).EndTime = tmpRst!EndTime
                
            End If
            
            SetClassInfo(i).ClassID = tmpRst!ClassID
            FillCardID SetClassInfo(i).EmployeeID, SetClassInfo(i).CardID
            If SetClassInfo(i).CardID = Space(8) Then
                MsgBox "cardID =    !!!"
            End If
            tmpRst.MoveNext
        Next
    End If
'=============================LeaveInfo=======================================


    
    strSQL = "  select a.EmployeeID,b.BeginDate,b.EndDate,b.TimeMode,b.BeginTime,b.EndTime,b.TimePos from LeaveInfo a " _
            & " left outer join LeaveInfo_D b on a.LeaveID=b.LeaveID where " _
            & " EndDate>= '" & sBeginTime & "' and BeginDate<='" & sEndTime & "' order by EmployeeID,TimePos"
    Debug.Print strSQL
    
    ReDim LeaveTypeInfo(0)
    tmpRst.Close
    Set tmpRst = Nothing
    tmpRst.Open strSQL, con, adOpenStatic, adLockBatchOptimistic
    lCount = tmpRst.RecordCount
    
    If lCount > 0 Then

        ReDim LeaveTypeInfo(lCount) As LeaveType
        blnLeaveTypeInfo = True
    
        tmpRst.MoveFirst
        For i = 1 To lCount
                    
                    
            If Trim(tmpRst!TimeMode) = "每天" Then
                LeaveTypeInfo(i).TimeMode = 0
            ElseIf Trim(tmpRst!TimeMode) = "每周" Then
                LeaveTypeInfo(i).TimeMode = 1
            ElseIf Trim(tmpRst!TimeMode) = "每月" Then
                LeaveTypeInfo(i).TimeMode = 2
            End If
                    
            
            
            If tmpRst!TimePos = "全天" Then
                LeaveTypeInfo(i).TimePos = 0
            Else
                LeaveTypeInfo(i).TimePos = Val(Mid(tmpRst!TimePos, 4, Len(tmpRst!TimePos) - 3))
            End If
            
            LeaveTypeInfo(i).EmployeeID = tmpRst.Fields("EmployeeID")
            LeaveTypeInfo(i).BeginTime = tmpRst.Fields("BeginTime")
            LeaveTypeInfo(i).EndTime = tmpRst.Fields("EndTime")
            
            LeaveTypeInfo(i).BeginDate = tmpRst!BeginDate
            LeaveTypeInfo(i).EndDate = tmpRst!EndDate

            tmpRst.MoveNext
        Next
        
    End If
    
'=============================InDataInfo=======================================

'    sBeginTime = Mid(sBeginTime, 1, 4) & Mid(sBeginTime, 6, 2) & Mid(sBeginTime, 9, 2)
'    sEndTime = Mid(sEndTime, 1, 4) & Mid(sEndTime, 6, 2) & Mid(sEndTime, 9, 2)
'
'    strSQL = "select InDate,InCode,InTime from indata where InDate Between '" _
'             & sBeginTime & "' and '" & sEndTime & " 'order by indate,incode,InTime asc"
'
'    tmpRst.Close
'    Set tmpRst = Nothing
'    tmpRst.Open strSQL, con, adOpenStatic, adLockBatchOptimistic
'    lCount = tmpRst.RecordCount
'
'    If lCount > 0 Then
'
'        ReDim InDataInfo(lCount) As InDataType
'        blnInDataInfo = True
'
'        tmpRst.MoveFirst
'        For i = 1 To lCount
'
'            InDataInfo(i).InDate = tmpRst.Fields("InDate")
'            InDataInfo(i).InCode = tmpRst.Fields("InCode")
'            InDataInfo(i).InTime = tmpRst.Fields("InTime")
'
'            tmpRst.MoveNext
'        Next
'
'    End If
    
    tmpRst.Close
    Set tmpRst = Nothing
    
End Sub



'===============利用员工名称，获得员工卡号
Public Sub FillCardID(ByVal EmployeeID As Long, ByRef CardID As String)
    If blnEmployeeInfo = False Then Exit Sub
    Dim upBound As Long
    upBound = UBound(EmployeeInfo, 1)
    Dim i As Integer
    For i = 1 To upBound
        If EmployeeInfo(i).EmployeeID = EmployeeID Then
            CardID = EmployeeInfo(i).CardID
            Exit Sub
        End If
    Next
    CardID = ""
End Sub

Public Function GetEmployeeVac(Code As String) As Long
    If blnEmployeeInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(EmployeeInfo)
    Dim i As Integer
    For i = 1 To upBound
        If EmployeeInfo(i).CardID = Code Then
            GetEmployeeVac = EmployeeInfo(i).VacID
            Exit Function
        End If
    Next
    GetEmployeeVac = 0

End Function


'=============利用员工卡号，获得员工名称
Public Sub GetEmployeeID(ByVal Code As String, ByRef EmployeeID As Integer)
    If blnEmployeeInfo = False Then Exit Sub
    Dim upBound As Long
    upBound = UBound(EmployeeInfo)
    Dim i As Integer
    For i = 1 To upBound
        If EmployeeInfo(i).CardID = Code Then
            EmployeeID = EmployeeInfo(i).EmployeeID
            Exit Sub
        End If
    Next
    EmployeeID = 0
End Sub



Public Function GetMaxTimeCount(ByVal dBeginDate As Date, ByVal dEndDate As Date) As Long
'    Dim tmpRst As New ADODB.Recordset
    Dim i As Long
    Dim lCount As Long
    Dim bTime As String
    Dim lCardCount As Long
    Dim MaxCount As Long
   
'    tmpRst.Open "select * from employee", con, adOpenStatic, adLockReadOnly
'    lCount = tmpRst.RecordCount
'
'    If lCount > 0 Then
'
'        ReDim EmployeeInfo(1 To lCount) As EmployeeType
'        tmpRst.MoveFirst
'        For i = 1 To lCount
'            EmployeeInfo(i).EmployeeName = tmpRst!Name
'            EmployeeInfo(i).ClassID = tmpRst!ClassID
'            EmployeeInfo(i).VacID = tmpRst!VacID
'            EmployeeInfo(i).CardID = tmpRst!Code
'            EmployeeInfo(i).EmployeeID = tmpRst!EmployeeID
'            tmpRst.MoveNext
'        Next
'
'    End If

    Dim lEmpRow As Long
    Dim lEmpCount As Long
    If blnEmployeeInfo = False Then Exit Function
    lEmpCount = UBound(EmployeeInfo)
    
    Do While dBeginDate <= dEndDate

        For lEmpRow = 1 To lEmpCount
        
            bTime = Format(dBeginDate, "yyyy-mm-dd")
            bTime = Mid(bTime, 1, 4) & Mid(bTime, 6, 2) & Mid(bTime, 9, 2)
            GetSetClassID EmployeeInfo(lEmpRow).CardID, bTime
            lCardCount = GetClassCount()
            If MaxCount < lCardCount Then MaxCount = lCardCount
            
        Next

        dBeginDate = dBeginDate + 1
    Loop
    GetMaxTimeCount = MaxCount
    
'    If tmpRst.State = 1 Then tmpRst.Close
'    Set tmpRst = Nothing
End Function


Public Function GetTimePosCount() As Long

    Dim tmpRst As New ADODB.Recordset
    Dim lCount As Long
    Dim i As Long
    Dim j As Long
    
    Dim tmps As String
    Dim tmps1 As Long
    Dim iValue As Long
    
    tmpRst.Open "select a.ClassID,a.ClassName,b.OnDutyTime,b.OffDutyTime from class a " _
        & "left outer join class_d b on a.ClassID=b.ClassID", con, adOpenStatic, adLockReadOnly
        
        
'    tmpRst.Open "select count(ClassID) as abc from Class_D", con, adOpenStatic, adLockReadOnly
'    GetTimePosCount = tmpRst.Fields("abc")
        
        
    lCount = tmpRst.RecordCount
    blnClassInfo = False
    If lCount > 0 Then

        ReDim ClassInfo(1 To lCount) As ClassType
        blnClassInfo = True
        
        tmpRst.MoveFirst
        For i = 1 To lCount
            ClassInfo(i).ClassName = tmpRst!ClassName
            ClassInfo(i).ClassID = tmpRst!ClassID

            tmps = tmpRst!OnDutyTime
            tmps1 = Val(Split(tmps, ":")(0))
            iValue = Val(tmps1)
            tmps1 = Val(Split(tmps, ":")(1))
            iValue = Val(tmps1) + iValue * 60
            ClassInfo(i).InTime = iValue

            tmps = tmpRst!OffDutyTime
            tmps1 = Val(Split(tmps, ":")(0))
            iValue = Val(tmps1)
            tmps1 = Val(Split(tmps, ":")(1))
            iValue = Val(tmps1) + iValue * 60
            ClassInfo(i).OutTime = iValue

            tmpRst.MoveNext
        Next

    End If

    Dim tmpClassID As Long
    Dim tmpClassName As String
    Dim tmpInTime As Long
    Dim tmpOutTime As Long
    
    If blnClassInfo = False Then Exit Function
    lCount = UBound(ClassInfo)

    For i = 1 To lCount - 1
        For j = i + 1 To lCount
            If ClassInfo(i).InTime > ClassInfo(j).InTime Then
                tmpClassID = ClassInfo(i).ClassID
                tmpClassName = ClassInfo(i).ClassName
                tmpInTime = ClassInfo(i).InTime
                tmpOutTime = ClassInfo(i).OutTime

                ClassInfo(i).ClassID = ClassInfo(j).ClassID
                ClassInfo(i).ClassName = ClassInfo(j).ClassName
                ClassInfo(i).InTime = ClassInfo(j).InTime
                ClassInfo(i).OutTime = ClassInfo(j).OutTime

                ClassInfo(j).ClassID = tmpClassID
                ClassInfo(j).ClassName = tmpClassName
                ClassInfo(j).InTime = tmpInTime
                ClassInfo(j).OutTime = tmpOutTime

            End If
        Next
    Next

    GetTimePosCount = 1
    For i = 1 To lCount - 1
        For j = i + 1 To lCount
            If ClassInfo(j).InTime > ClassInfo(i).OutTime Then
                GetTimePosCount = GetTimePosCount + 1
                i = j - 1
                Exit For
            End If
        Next
    Next
    
    If tmpRst.State = 1 Then tmpRst.Close
    Set tmpRst = Nothing
    

End Function

Public Function GetOnClassID(ByVal sCode As String, ByVal sDate As String)
    Dim j As Long
    Dim i As Long
    Dim X As Long
    Dim upBound As Long
    
    Dim lDate As Long
    lDate = Val(Mid(sDate, 1, 4)) * 600 + Val(Mid(sDate, 5, 2)) * 50 + Val(Mid(sDate, 7, 2))
    
    X = GetClassID(sCode)
    
    If blnOnClassInfo = False Then Exit Function
    upBound = UBound(OnClassInfo)
    For i = 1 To upBound
        If OnClassInfo(i).OnClassID = X Then
        
            If lDate >= OnClassInfo(i).BeginDate And lDate <= OnClassInfo(i).EndDate Then
            
                If ClassIDInfo(UBound(ClassIDInfo)).ClassID <> 0 Then ReDim Preserve ClassIDInfo(UBound(ClassIDInfo) + 1)
                
                If OnClassInfo(i).TimeMode = 0 Then
                
                    ClassIDInfo(UBound(ClassIDInfo)).AddClass = False
                    ClassIDInfo(UBound(ClassIDInfo)).ClassID = OnClassInfo(i).ClassID
                    
                ElseIf OnClassInfo(i).TimeMode = 1 Then
                
                    Dim dtm As Date
                    Dim iWeek As Integer
                    
                    dtm = CDate(Mid(sDate, 1, 4) & "-" & Mid(sDate, 5, 2) & "-" & Mid(sDate, 7, 2))
                    iWeek = Weekday(dtm)
                    
                    If iWeek = 1 Then iWeek = 7 Else iWeek = iWeek - 1
                           
                    If iWeek >= OnClassInfo(i).BeginTime And iWeek <= OnClassInfo(i).EndTime Then
                        ClassIDInfo(UBound(ClassIDInfo)).AddClass = False
                        ClassIDInfo(UBound(ClassIDInfo)).ClassID = OnClassInfo(i).ClassID
                    End If
                
                ElseIf OnClassInfo(i).TimeMode = 2 Then
                
                    Dim lDay As Long
                    lDay = Right(sDate, 2)
    
                    If (lDay >= OnClassInfo(i).BeginTime) And (lDay <= OnClassInfo(i).EndTime) Then