frmteachlab.frm

一个自己做的电力管理系统,主要用于电力电业行业的管理

         ForeColor       =   &H00C0C000&
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   2535
      End
   End
End
Attribute VB_Name = "frmteachlab"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public i As Integer           'i 为输出数据项的文本框数组的下标
Public dataTable As String    'datatable为所要的查询表
Public selectkey As String    'selectKey 为所要查询的关键字


Private Sub cmdAdd_Click()                '添加数据
    Me.cmdDel.Enabled = False               '使删除按钮和更新按钮无效
    Me.cmdUpdata.Enabled = False
    Me.cmdSave.Enabled = True
    Me.DTPicker1.Visible = True           '显示时间选项
    Me.txtData(6).Visible = False
End Sub

Private Sub cmdCancel_Click()             '取消
    Me.cmdAdd.Enabled = True
    Me.cmdDel.Enabled = True
    Me.cmdUpdata.Enabled = True
    Me.cmdSave.Enabled = False
End Sub

Private Sub cmdClean_Click()              '清除数据
   Dim j As Integer
   For j = 0 To i
       Me.txtData(j).Text = ""
       Next j
End Sub

Private Sub cmdDel_Click()                    '删除数据
    On Error GoTo errh
    Dim str As String                              '接受查询语句
    Dim Answer As String
    Dim j As Integer
    If Me.txtData(0).Text = "" Then                             '学号为空时不能删除数据
       MsgBox " 你没有要删除的数据，请查询数据后再删除"
       Exit Sub
    End If
     Answer = MsgBox("删除后无法恢复，你可要想好了，确实要删除吗？", vbYesNo, "警告！！")
     If Answer = vbYes Then
        Set rs = New ADODB.Recordset
        MakeConnection                                  '连接数据库
        Set rs.ActiveConnection = CN
        rs.Source = "select * from " & dataTable
        rs.Open                                         '删除信息
        str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
        CN.Execute str
        delConnection                                    '断开数据库
                       '清空纪录
        For j = 0 To i - 1
            Me.txtData(j) = ""
            Next j
        MsgBox "删除成功！"
        Exit Sub
      Else
        Exit Sub                                          '防止没有操作时，出现错误提示框
     End If
errh:
         MsgBox Err.Description
End Sub

Private Sub cmdExit_Click()             '退出窗体
    Unload Me
End Sub

Private Sub cmdSave_Click()             '保存数据
     On Error GoTo errh
     Dim j As Integer
     Dim str As String
     Dim strLb As String
     DTPicker1.Visible = False
     Me.txtData(6).Visible = True
     If Me.txtData(0).Text = "" Then
       strLb = "请输入" & Me.Label1.Caption
       MsgBox strLb
       Me.txtData(0).SetFocus
       Exit Sub
    End If
  If Me.txtData(0).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label1.Caption, Len(Trim(Me.Label1.Caption)) - 1))
   MsgBox strLb
   Me.txtData(0).SetFocus
   Exit Sub
End If
If Me.txtData(1).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label2(0).Caption, Len(Trim(Me.Label2(0).Caption)) - 1))
   MsgBox strLb
   Me.txtData(1).SetFocus
   Exit Sub
End If
If Me.txtData(2).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label3.Caption, Len(Trim(Me.Label3.Caption)) - 1))
   MsgBox strLb
   Me.txtData(2).SetFocus
   Exit Sub
End If
If Me.txtData(3).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label4.Caption, Len(Trim(Me.Label4.Caption)) - 1))
   MsgBox strLb
   Me.txtData(3).SetFocus
   Exit Sub
End If
If Me.txtData(4).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label5.Caption, Len(Trim(Me.Label5.Caption)) - 1))
   MsgBox strLb
   Me.txtData(4).SetFocus
   Exit Sub
End If
If Me.txtData(5).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label6.Caption, Len(Trim(Me.Label6.Caption)) - 1))
   MsgBox strLb
   Me.txtData(5).SetFocus
   Exit Sub
    Else
       Set rs = New ADODB.Recordset
       MakeConnection
       Set rs.ActiveConnection = CN
       rs.Source = "select * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
       rs.Open
       If rs.EOF Then
           delConnection
           MakeConnection
           Set rs = New ADODB.Recordset
           rs.LockType = adLockOptimistic
           rs.CursorType = adOpenKeyset
           rs.Open dataTable, CN, , , adCmdTable
           rs.AddNew
           Me.txtData(6).Text = Me.DTPicker1.Value
           For j = 0 To i - 1
               rs.Fields(j).Value = Me.txtData(j).Text
               Next j
           rs.Update
           delConnection        '断开连接
           MsgBox "保存在成功！", vbOKOnly, "恭喜你！"
           Exit Sub
       Else
          If Me.txtData(0).Text = rs.Fields(0).Value Then
              MsgBox "数据库中已经存在数据，请重新输入"
              Me.txtData(0).SetFocus
              Exit Sub
          End If
       End If
    End If
    
errh:                             '错误信息
         MsgBox Err.Description
End Sub

Private Sub cmdSelect_Click()       '查询信息
     On Error GoTo errh
     Dim i As Integer
     Dim dataTable As String
     Dim selecKey As String
    If txtData(i).Text = "" Then
        MsgBox "请在框中输入关键的数据，以便查询"
        txtData(i).SetFocus
        Exit Sub
    End If
    Dim str As String
    Dim j As Integer
    Set rs = New ADODB.Recordset
       MakeConnection
    Set rs.ActiveConnection = CN
    rs.Source = " select * from " & dataTable & " where  " & selectkey & "='" & txtData(i).Text & "'"
    rs.Open
    If rs.EOF Then
        MsgBox "没有找到你所要求的纪录！请重新输入关键字！"
        delConnection
        txtData(i) = ""
        txtData(i).SetFocus
        Exit Sub
    Else
       If txtData(i).Text = rs.Fields(0).Value Then
          Me.txtData(6).Visible = True
          Me.DTPicker1.Visible = False
          For j = 0 To i - 1                             '将数据库的值显示出来
              txtData(j).Text = rs.Fields(j).Value
              Next j
          delConnection
          MsgBox "找到你要查询的数据"
          Exit Sub
        End If
    End If
errh:
         MsgBox Err.Description
End Sub

Private Sub cmdUpdata_Click()
     On Error GoTo errh
     Dim j As Integer
     Dim dataTable As String
     Dim selecKey As String
     Dim str As String
        
        Me.cmdAdd.Enabled = False
        Me.cmdDel.Enabled = False
        Me.cmdSave.Enabled = True
        If Me.txtData(0).Text = "" Then
            MsgBox "你没有要更新的内容，请查询后再更新！"
            Exit Sub
        End If
        Set rs = New ADODB.Recordset       '更新之前，先删除旧的信息
        MakeConnection
        Set rs.ActiveConnection = CN
        rs.Source = "select * from " & dataTable
        rs.Open
        str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
        CN.Execute str
        delConnection      '断开连接
                           '写入新数据
        MakeConnection
        Set rs = New ADODB.Recordset
        rs.LockType = adLockOptimistic
        rs.CursorType = adOpenKeyset
        rs.Open dataTable, CN, , , adCmdTable
        rs.AddNew
        For j = 0 To i - 1
            rs.Fields(j).Value = Me.txtData(j).Text
            Next j
        rs.Update
        delConnection        '断开连接
        MsgBox "更新成功！", vbOKOnly, "恭喜你！"
        Exit Sub
errh:
             MsgBox Err.Description
End Sub

Private Sub Form_Load()
   Me.txtData(6).Visible = False
   Me.DTPicker1.Visible = True
   i = 7
   dataTable = "教学大纲表"
   selectkey = "教学大纲号"
   MakeCenter Me                '窗体位于屏幕中间
End Sub