frmsuminout.frm

用VB6.0编写工资管理系统

VERSION 5.00
Begin VB.Form frmSumInOut 
   Caption         =   "统计出勤记录"
   ClientHeight    =   3615
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5745
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3615
   ScaleWidth      =   5745
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取  消"
      Height          =   495
      Left            =   3240
      TabIndex        =   3
      Top             =   2160
      Width           =   1455
   End
   Begin VB.ComboBox comMonth 
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2640
      TabIndex        =   2
      Top             =   1080
      Width           =   1575
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确   定"
      Height          =   495
      Left            =   1200
      TabIndex        =   1
      Top             =   2160
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "统计月份"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1200
      TabIndex        =   0
      Top             =   1080
      Width           =   1215
   End
End
Attribute VB_Name = "frmSumInOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
    Exit Sub
End Sub

Private Sub cmdOK_Click()
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim rsPerson As New ADODB.Recordset
    Dim rsRecord As New ADODB.Recordset
    Dim iOComTimes As Integer                            '正常加班天数
    Dim iOSpeTimes As Integer                            '特殊加班天数
    Dim iErrandTimes As Integer                          '出差天数
    Dim iLETimes As Integer                              '迟到早退次数
    Dim iAbsentTimes As Integer                          '旷工次数
    Dim iOutTimes As Integer                             '出勤天数
    Dim firstday As String
    Dim days As Integer
    Dim lastday As String
    
    firstday = Year(Date) & "-" & Me.comMonth.Text & "-1"
    days = DateDiff("d", Year(Date) & "-" & Me.comMonth.Text & "-1", _
                            Year(Date) & "-" & Me.comMonth.Text + 1 & "-1")
    lastday = Year(Date) & "-" & Me.comMonth.Text & "-" & days
    
    sql = "select * from AttendanceStatistics where RecordMonth between #"
    sql = sql & firstday & "# and #" & lastday & "#"
    Set rsRecord = getRS(sql, "Salary")
    If rsRecord.EOF = False Then                        '判断是否已经统计
        MsgBox "已经统计！", vbOKOnly + vbExclamation, "提示！"
        frmAResult.Show
        frmAResult.ZOrder 0
        rsRecord.Close
        Unload Me
        Exit Sub
    End If
    
    sql = "select * from AttendanceInfo where ADate between #"
    sql = sql & firstday & "# and #" & lastday & "#"
    Set rsRecord = getRS(sql, "Person")
    
    If rsRecord.EOF = False Then                         '判断是否含有出勤信息
    sql = "select SID,SName from StuffInfo order by SID"
    Set rsPerson = getRS(sql, "Person")
    While Not rsPerson.EOF
        iOutTimes = 0
        iOComTimes = 0
        iOSpeTimes = 0
        iErrandTimes = 0
        iLETimes = 0
        iAbsentTimes = 0
        sql = "select * from AttendanceInfo where AStuffID='"
        sql = sql & rsPerson(0) & "' and AFlag='入'"
        Set rs = getRS(sql, "Person")
        iOutTimes = rs.RecordCount
        rs.Close
        
        sql = "select ALate from AttendanceInfo where ALate=1 and AStuffID='"
        sql = sql & rsPerson(0) & "' and ADate between #" & firstday & "# and #"
        sql = sql & lastday & "#"
        Set rs = getRS(sql, "Person")
        While Not rs.EOF
        iLETimes = rs(0) + iLETimes
        rs.MoveNext
        Wend
        rs.Close
        
        sql = "select AEarly from AttendanceInfo where AEarly=1 and AStuffID='"
        sql = sql & rsPerson(0) & "' and ADate between #" & firstday & "# and #"
        sql = sql & lastday & "#"
        Set rs = getRS(sql, "Person")
        While Not rs.EOF
        iLETimes = iLETimes + rs(0)
        rs.MoveNext
        Wend
        rs.Close
        
        sql = "select OCommon from OvertimeInfo where OStuffID='"
        sql = sql & rsPerson(0) & "' and OFromDay between #" & firstday & "# and #"
        sql = sql & lastday & "#"
        Set rs = getRS(sql, "Person")
        While Not rs.EOF
            iOComTimes = iOComTimes + rs(0)
            rs.MoveNext
        Wend
        rs.Close
        
        sql = "select OSpeciality from OvertimeInfo where OStuffID='"
        sql = sql & rsPerson(0) & "' and OFromDay between #" & firstday & "# and #"
        sql = sql & lastday & "#"
        Set rs = getRS(sql, "Person")
        While Not rs.EOF
            iOSpeTimes = iOSpeTimes + rs(0)
            rs.MoveNext
        Wend
        rs.Close
        
        sql = "select EErranddays from ErrandInfo where EStuffID='"
        sql = sql & rsPerson(0) & "' and EFromday between #" & firstday & "# and #"
        sql = sql & lastday & "#"
        Set rs = getRS(sql, "Person")
        While Not rs.EOF
            iErrandTimes = iErrandTimes + rs(0)
            rs.MoveNext
        Wend
        rs.Close
       
        If iOutTimes < 20 Then
            iAbsentTimes = 20 - iOutTimes
        End If
            
        sql = "select * from AttendanceStatistics"        '添加记录
        Set rs = getRS(sql, "Salary")
        rs.AddNew
        rs.Fields(1) = rsPerson(0)
        rs.Fields(2) = rsPerson(1)
        rs.Fields(3) = Date
        rs.Fields(4) = iOutTimes
        rs.Fields(5) = iLETimes
        rs.Fields(6) = iAbsentTimes
        rs.Fields(7) = iOComTimes
        rs.Fields(8) = iOSpeTimes
        rs.Fields(9) = iErrandTimes
        rs.Update
        rs.Close
        
        rsPerson.MoveNext
    Wend
        MsgBox "完成统计！", vbOKOnly + vbExclamation, "提示！"
        frmAResult.Show
        frmAResult.ZOrder 0
        Unload Me
    Else
        MsgBox "请重新选择！", vbOKOnly + vbExclamation, "提示！"
        Me.ZOrder 0
    End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    For i = 1 To 12
        Me.comMonth.AddItem i
    Next i
    Me.comMonth.ListIndex = 0
End Sub