sqltmp2.frm

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

         TabIndex        =   16
         Top             =   0
         Width           =   735
      End
      Begin VB.PictureBox Picture1 
         Height          =   0
         Left            =   0
         ScaleHeight     =   0
         ScaleWidth      =   0
         TabIndex        =   15
         Top             =   0
         Width           =   0
      End
      Begin VB.CommandButton Command1 
         Caption         =   "打印"
         Height          =   500
         Index           =   1
         Left            =   0
         Picture         =   "SQLtmp2.frx":067E
         Style           =   1  'Graphical
         TabIndex        =   14
         Top             =   0
         Width           =   735
      End
      Begin VB.CommandButton Command1 
         Caption         =   "查询"
         Height          =   500
         Index           =   0
         Left            =   840
         Picture         =   "SQLtmp2.frx":0780
         Style           =   1  'Graphical
         TabIndex        =   13
         Top             =   0
         Width           =   735
      End
   End
End
Attribute VB_Name = "SQLtmp2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim mDB As mDB

Dim db As ADODB.Connection
'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 Database_Refresh(xMode As Integer)
    On Error Resume Next
    Set db = New ADODB.Connection
        db.CursorLocation = adUseClient
        

db.ConnectionString = strConnDR
db.Open       '连接数据库
    
    If xMode = 0 Then
        Set adoprimaryRS = New ADODB.Recordset
        adoprimaryRS.Open strSQL, db, adOpenStatic, adLockOptimistic
    ElseIf xMode = 1 Then
        Set adoprimaryRS2 = New ADODB.Recordset
        adoprimaryRS2.Open strSQL2, db, adOpenStatic, adLockOptimistic
    ElseIf xMode = 2 Then
        Set adoPrimaryRS3 = New ADODB.Recordset
        adoPrimaryRS3.Open strSQL3, db, adOpenStatic, adLockOptimistic
    ElseIf xMode = 3 Then
        Set adoPrimaryRS4 = New ADODB.Recordset
        adoPrimaryRS4.Open strSQL4, db, adOpenStatic, adLockOptimistic
    End If
End Sub






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"
Database_Refresh 0

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  ''
If Option1(0).Value Then
    If DataCombo1(0).BoundText = "" Then
   '''***** "" & _   *****
'    strSQL2 = "SELECT emplyid, emplyname, caldate, drawtmend1, workwktm" & _
'        "   From wktmrslt" & _
'        "   WHERE workwktm BETWEEN 1 AND 9"
    strSQL2 = "select * from empcrdtm where  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'"   ''''' order by crdtmid,empcrdtm.emplyid,cdatetime"

'    strSQL2 = "select empcrdtm.emplyid,emplyname,cdatetime,inorout,isovertime from emply,empcrdtm where emply.emplyid=empcrdtm.emplyid   and 4>(select count(*) from empcrdtm group by emplyid,left(cdatetime,10)) " & _
'            "  and  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "' order by empcrdtm.emplyid,cdatetime"
    Else
    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 & ")" ''''& _
        " order by empcrdtm.emplyid,cdatetime"
        
        
        
'    strSQL2 = "SELECT emplyid, emplyname, caldate, drawtmend1, workwktm" & _
'        "   From wktmrslt" & _
'        "   WHERE workwktm BETWEEN 1 AND 9" & _
'        "   and dptid=" & DataCombo1(0).BoundText
    
'    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 * from empcrdtm where  cdatetime between  '" & DTPicker1(0).Value & " " & SETIMER1(0).Text & "' and  '" & DTPicker1(1).Value & " " & SETIMER1(1).Text & "'" & _
        "   and emplyid = '" & Text1.Text & "'" & _
        " order by empcrdtm.emplyid,cdatetime"
'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
Database_Refresh 1
  With DataGrid1
  .ClearFields
  Set .DataSource = adoprimaryRS2
'.Columns(0).DataField = "emplyid"
'.Columns(1).DataField = "emplyname"
'.Columns(2).DataField = "cdatetime"
'.Columns(3).DataField = "inorout"
'.Columns(4).DataField = "isovertime"
'.Columns(0).width = 1200
'.Columns(1).width = 1200
'.Columns(2).width = 2400
'.Columns(3).width = 1200
'.Columns(4).width = 1200
'.Columns(0).Caption = "工号"
'.Columns(1).Caption = "姓名"
'.Columns(2).Caption = "打卡时间"
'.Columns(3).Caption = "进/出"
'.Columns(4).Caption = "是否加班"
.Refresh
End With


  
Case 1  '''
''''''''=========================================
Dim tempID As Long

strSQL = "select * from empcrdtm order by crdtmid"
Database_Refresh 0
adoprimaryRS2.MoveFirst
Do While Not adoprimaryRS2.EOF
With adoprimaryRS
.MoveLast
tempID = .Fields("crdtmid").Value + 1
.AddNew
.Fields("crdtmid").Value = tempID
.Fields("emplyid").Value = adoprimaryRS2.Fields("emplyid").Value
.Fields("empcrdno").Value = adoprimaryRS2.Fields("empcrdno").Value
.Fields("deviceid").Value = adoprimaryRS2.Fields("deviceid").Value
.Fields("reasonid").Value = adoprimaryRS2.Fields("reasonid").Value
.Fields("inorout").Value = adoprimaryRS2.Fields("inorout").Value
.Fields("cdatetime").Value = DateAdd("d", -1, adoprimaryRS2.Fields("cdatetime").Value)
.Fields("isovertime").Value = adoprimaryRS2.Fields("isovertime").Value
.Fields("recordtype").Value = adoprimaryRS2.Fields("recordtype").Value
.Fields("operid").Value = adoprimaryRS2.Fields("operid").Value
.Update
End With
adoprimaryRS2.MoveNext
Loop
MsgBox "ok!!!"
''''''''=========================================

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
Database_Refresh 1
MsgBox "OK!"

Case 3
Dim o As New ToExcel
o.ToExcel adoprimaryRS2, "newasia"
Set o = Nothing


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

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