sqltmp10.frm

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

         Left            =   0
         Picture         =   "SQLtmp10.frx":0554
         Style           =   1  'Graphical
         TabIndex        =   17
         Top             =   0
         Width           =   735
      End
      Begin VB.PictureBox Picture1 
         Height          =   0
         Left            =   0
         ScaleHeight     =   0
         ScaleWidth      =   0
         TabIndex        =   16
         Top             =   0
         Width           =   0
      End
      Begin VB.CommandButton Command1 
         Caption         =   "导出"
         Height          =   500
         Index           =   3
         Left            =   2520
         Picture         =   "SQLtmp10.frx":0656
         Style           =   1  'Graphical
         TabIndex        =   15
         Top             =   0
         Width           =   735
      End
      Begin VB.CommandButton Command1 
         Caption         =   "删除"
         Height          =   500
         Index           =   2
         Left            =   1680
         Picture         =   "SQLtmp10.frx":0960
         Style           =   1  'Graphical
         TabIndex        =   14
         Top             =   0
         Width           =   735
      End
      Begin VB.CommandButton Command1 
         Caption         =   "加班"
         Height          =   500
         Index           =   4
         Left            =   3360
         Picture         =   "SQLtmp10.frx":0A62
         Style           =   1  'Graphical
         TabIndex        =   13
         Top             =   0
         Width           =   735
      End
   End
End
Attribute VB_Name = "SQLtmp10"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Dim mDB As New mDB
'Dim strConn As String


Dim strSQL  As String
Dim WithEvents adoprimaryRS As ADODB.Recordset
Attribute adoprimaryRS.VB_VarHelpID = -1
Dim strSQL2  As String
Dim WithEvents adoprimaryRS2 As ADODB.Recordset
Attribute adoprimaryRS2.VB_VarHelpID = -1
Dim strSQL3  As String
Dim WithEvents adoPrimaryRS3 As ADODB.Recordset
Attribute adoPrimaryRS3.VB_VarHelpID = -1
Dim strSQL4  As String
Dim WithEvents adoPrimaryRS4 As ADODB.Recordset
Attribute adoPrimaryRS4.VB_VarHelpID = -1



Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   'Sort by clicked column
   With adoprimaryRS2
     .Sort = .Fields(ColIndex).Name & " ASC"
   End With
   DataGrid1.Refresh


End Sub

Private Sub Form_Load()


'strConn = SQLcon


Set mDB = New mDB
mDB.InitDB_RY strConnDR



    strSQL = "select dptid,dptname from depart order by dptname asc"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)

With DataCombo1(0)
Set .RowSource = adoprimaryRS
    .BoundColumn = "dptid"
    .ListField = "dptname"
    .Refresh
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, "yyyy-mm-dd")  ''' Date
  DTPicker1(1).Value = DTPicker1(0).Value
  
'  DTPicker1(0).Value = Date
'  DTPicker1(1).Value = Date
  Option1(0).Value = True
  SETIMER1(0).Text = "00:00:01"
  SETIMER1(1).Text = "23:59:59"
    CenterForm Me
End Sub


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






Private Sub Command1_Click(Index As Integer)
  On Error GoTo AddErr
Select Case Index
Case 0  ''
''''''''=========================================
Screen.MousePointer = vbHourglass
sForm.A_MES "系统正在加载数据，请稍候******"
''''''''=========================================
If Option1(0).Value Then
    If DataCombo1(0).BoundText = "" Then
'    strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
    strSQL2 = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间,inorout as 进出,isovertime as 加班 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
    Else
'    strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid and emply.dptid=" & DataCombo1(0).BoundText & "and cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
    strSQL2 = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间,inorout as 进出,isovertime as 加班 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid and emply.dptid=" & DataCombo1(0).BoundText & "and cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
    'strSQL2 = "select * from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'" & _
    '            " and emplyid in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
    End If
ElseIf Option1(1).Value Then
strSQL2 = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间,inorout as 进出,isovertime as 加班 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid and emply.emplyid='" & Text1.Text & "' and cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
'strSQL2 = "select * from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & SETIMER1(1).Text & "'" & _
'            " and emplyid='" & Text1.Text & "'"   ''' in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
ElseIf Option1(0).Value And DataCombo1(0).BoundText = "" Then
strSQL2 = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间,inorout as 进出,isovertime as 加班 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"

End If
Set adoprimaryRS2 = mDB.adoprimaryRS(strSQL2)
  With DataGrid1
  .ClearFields
  Set .DataSource = adoprimaryRS2
'.Columns(0).DataField = "dptname"
'.Columns(1).DataField = "emplyid"
'.Columns(2).DataField = "emplyname"
'.Columns(3).DataField = "cdatetime"
'.Columns(4).DataField = "inorout"
'.Columns(5).DataField = "isovertime"
.Columns(0).width = 3000
.Columns(1).width = 1200
.Columns(2).width = 1200
.Columns(3).width = 2400
.Columns(4).width = 1200
.Columns(5).width = 1200
'.Columns(0).Caption = "部门"
'.Columns(1).Caption = "工号"
'.Columns(2).Caption = "姓名"
'.Columns(3).Caption = "打卡时间"
'.Columns(4).Caption = "进/出"
'.Columns(5).Caption = "是否加班"
.Refresh
End With
Label2.Caption = adoprimaryRS2.RecordCount
Screen.MousePointer = 0
  
Case 1  '''

Case 2
If Option1(0).Value Then
    If DataCombo1(0).BoundText = "" Then
    If MsgBox("当心，你将要删除大量记录！", vbYesNo, "newasia") = vbNo Then Exit Sub
    strSQL2 = "delete  from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"
    Else
    strSQL2 = "delete  from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'" & _
                " and emplyid in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
    End If
ElseIf Option1(1).Value Then
strSQL2 = "delete from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'" & _
            " and emplyid='" & Text1.Text & "'"   ''' in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
End If
Set adoprimaryRS2 = mDB.adoprimaryRS(strSQL2)
MsgBox "OK!"

Case 3
'Dim o As New ToExcel
'o.ToExcel adoPrimaryRS2, "newasia"
'Set o = Nothing
'Dim o As New cExcel
'o.ToExcel adoPrimaryRS2, "NewAsia"
'Set o = Nothing
'''''''''=========================================
'Screen.MousePointer = vbHourglass
'sForm.A_MES "系统正在加载数据，请稍候******"
'''''''''=========================================
'If Option1(0).Value Then
'    If DataCombo1(0).BoundText = "" Then
'    strSQL2 = "insert 工号,姓名,打卡时间,进出,是否考勤  into kaoqin in ""PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\人员更新.mdb"" (select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "')"  '' order by empcrdtm.emplyid,cdatetime"
'    Else
'    strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid and emply.dptid=" & DataCombo1(0).BoundText & "and cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
'    'strSQL2 = "select * from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'" & _
'    '            " and emplyid in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
'    End If
'ElseIf Option1(1).Value Then
'strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid and emply.emplyid='" & Text1.Text & "' and cdatetime between '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
''strSQL2 = "select * from empcrdtm where  cdatetime between '" & DTPicker1(0).Value & SETIMER1(0).Text & "' and '" & DTPicker1(1).Value & SETIMER1(1).Text & "'" & _
''            " and emplyid='" & Text1.Text & "'"   ''' in (select emplyid from emply where dptid=" & DataCombo1(0).BoundText & ")"
'ElseIf Option1(0).Value And DataCombo1(0).BoundText = "" Then
'strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"  '' order by empcrdtm.emplyid,cdatetime"
'
'End If
'Debug.Print strSQL2
'
'Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
'
'Screen.MousePointer = 0

'        If Len(Dir(App.Path & "\tmp.rst")) Then
'        Kill App.Path & "\tmp.rst"
'        End If
'        adoPrimaryRS2.Save App.Path & "\tmp.rst"
'
'
'        adoPrimaryRS3.Open App.Path & "\tmp.rst", , adOpenStatic, adLockOptimistic, adCmdFile
'
'Debug.Print adoPrimaryRS3.RecordCount
'
If adoprimaryRS2.RecordCount > 32560 Then
MsgBox "对不起，数据量太大，不能导出到EXCEL。", vbOKOnly, "NewAsia"
Exit Sub
Else
ToExcel.ToExcel adoprimaryRS2, "newasia"
End If


Case 4
With adoprimaryRS2
.MoveFirst
Do While Not .EOF
.Fields("isovertime").Value = 1
.Update
.MoveNext
Loop
End With


End Select
  Exit Sub
AddErr:
  MsgBox Err.Description
Exit Sub
End Sub

    ''''=======================================================