frmriqi.frm

请假销假的管理系统

VERSION 5.00
Begin VB.Form frmriqi 
   Caption         =   "输入日期"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   495
      Left            =   1440
      TabIndex        =   2
      Top             =   2280
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1560
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "格式为(2004-04-12)"
      Height          =   180
      Left            =   1800
      TabIndex        =   3
      Top             =   1200
      Width           =   1620
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "输入日期"
      Height          =   180
      Left            =   360
      TabIndex        =   0
      Top             =   600
      Width           =   720
   End
End
Attribute VB_Name = "frmriqi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
  If Not IsDate(Format(Trim(Text1.Text), "yyyy-mm-dd")) Then
     MsgBox "请输入正确的日期格式！", vbOKOnly + vbExclamation, "警告"
     Text1.SetFocus
     Exit Sub
   End If
  
  Dim mrccc1, mr As ADODB.Recordset
  Dim msgtext1 As String
  Dim txtSQL As String
  Dim a, b As String
  Dim i As Integer
  i = 1
  txtSQL = "delete from 请假1 where 班级<>''"
  Set mrccc1 = ExecuteSQL(txtSQL, msgtext1)
  a = Format(CDate(Text1.Text), "yyyy-mm-dd")
  txtSQL = "select * from 请假 where 日期='" & a & "'"
  Set mrccc1 = ExecuteSQL(txtSQL, msgtext1)
  b = msgtext1
  If mrccc1.EOF = True Then
    MsgBox "找不到任何纪录！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
  Else
      Do While Not mrccc1.EOF
        txtSQL = "insert into 请假1 values('" & mrccc1.Fields(0) & "','" & mrccc1.Fields(1) & "','" & mrccc1.Fields(2) & "','" & mrccc1.Fields(3) & "','" & mrccc1.Fields(4) & "','" & Format(mrccc1.Fields(5), "yyyy-mm-dd") & "','" & mrccc1.Fields(6) & "','" & mrccc1.Fields(7) & "','" & Format(mrccc1.Fields(8), "yyyy-mm-dd") & "','" & mrccc1.Fields(9) & "','" & mrccc1.Fields(10) & "')"
        Set mr = ExecuteSQL(txtSQL, msgtext1)
        mrccc1.MoveNext
    Loop
     mrccc1.Close
    a = MsgBox(b & ",是否生成报表？", vbOKCancel, "警告")
   If a = vbOK Then
        DataReport1.Show
     ' DataEnvironment1.Connection2.Close
    '  DataEnvironment1.Connection2.Open
     ' DataEnvironment1.Commands("Command3").ActiveConnection = DataEnvironment1.Connection2
     ' DataEnvironment1.Commands("Command3").CommandText = "dbo.请假1"
    
   End If
  End If
  Unload Me
End Sub

Private Sub Form_Load()
  
  Me.Height = 3600
  Me.Width = 4800
  Me.Top = MDIForm1.Top + 500
   Me.Left = MDIForm1.Left + 500
End Sub