frmsuminout.frm

软件需求一般包含三个层次—业务需求、用户需求和功能需求

VERSION 5.00
Begin VB.Form frmsuminout 
   Caption         =   "统计出勤记录"
   ClientHeight    =   3750
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5490
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3750
   ScaleWidth      =   5490
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdcancel 
      Caption         =   "取 消"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3000
      TabIndex        =   3
      Top             =   2520
      Width           =   1215
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "确 定"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1080
      TabIndex        =   2
      Top             =   2520
      Width           =   1215
   End
   Begin VB.ComboBox commonth 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2400
      TabIndex        =   1
      Text            =   " "
      Top             =   840
      Width           =   2055
   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          =   495
      Left            =   720
      TabIndex        =   0
      Top             =   840
      Width           =   1335
   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