frmscoreinput.frm

一个功能强大、程序条理分明的学生学籍管理系统

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{C2A990D9-DFD1-4B7C-A432-A1DD219DC55F}#1.0#0"; "UserCtrProj.ocx"
Begin VB.Form frmScoreInput 
   Caption         =   "学生成绩录入"
   ClientHeight    =   3915
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5970
   LinkTopic       =   "Form2"
   MDIChild        =   -1  'True
   ScaleHeight     =   3915
   ScaleWidth      =   5970
   WindowState     =   2  'Maximized
   Begin UserCtrProj.UsrPicBtn cmdReadFile 
      Height          =   525
      Left            =   2760
      TabIndex        =   8
      Top             =   3120
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   926
      Picture         =   "frmScoreInput.frx":0000
      Caption         =   "       从文件中读取数据"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComDlg.CommonDialog comDLgOpen 
      Left            =   600
      Top             =   720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdEndInput 
      Caption         =   "结束逐条录入"
      Height          =   375
      Left            =   3360
      TabIndex        =   7
      Top             =   360
      Width           =   1455
   End
   Begin VB.CommandButton cmdStarInput 
      Caption         =   "开始逐条录入"
      Height          =   375
      Left            =   1440
      TabIndex        =   6
      Top             =   360
      Width           =   1455
   End
   Begin UserCtrProj.UsrCtrCombo cboCourseID 
      Height          =   375
      Left            =   2760
      TabIndex        =   5
      Top             =   960
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   661
      Enabled         =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleWidth      =   2175
      ScaleMode       =   0
      ScaleHeight     =   375
      ListIndex       =   -1
      FontSize        =   8.25
      FontName        =   "MS Sans Serif"
   End
   Begin UserCtrProj.UsrCtrText txtScore 
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      Top             =   2400
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   661
      Enabled         =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      FontSize        =   8.25
      FontName        =   "MS Sans Serif"
   End
   Begin UserCtrProj.UsrCtrText txtStudentID 
      Height          =   375
      Left            =   2760
      TabIndex        =   2
      Top             =   1680
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   661
      Enabled         =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      FontSize        =   8.25
      FontName        =   "MS Sans Serif"
   End
   Begin VB.Label lblScore 
      Caption         =   "成绩："
      Height          =   375
      Left            =   1440
      TabIndex        =   3
      Top             =   2400
      Width           =   1095
   End
   Begin VB.Label lblStudentID 
      Caption         =   "学号："
      Height          =   375
      Left            =   1440
      TabIndex        =   1
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label lblCourseID 
      Caption         =   "课程代号："
      Height          =   255
      Left            =   1440
      TabIndex        =   0
      Top             =   960
      Width           =   1095
   End
End
Attribute VB_Name = "frmScoreInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim strPath As String '文档路径
Dim rsCoursesInfo As ADODB.Recordset
Dim rsScoreInfo As ADODB.Recordset

'字符串常量，定义最初的SQL语句
Const strCoursesSql = "select * from uCoursesInfo"
Const strScoreSql = "select * from uScoreInfo"

'该过程用来设置控件的Enbaled属性
Public Sub ChangeEnabled(blnState As Boolean)
    cboCourseID.Enabled = blnState
    txtStudentID.Enabled = blnState
    txtScore.Enabled = blnState
End Sub

Private Sub cmdEndInput_Click()
     ChangeEnabled False
End Sub

Private Sub cmdReadFile_Click()
    '定义一个文件号，用来打开文本文件
    Dim iFileNumber As Integer
    Dim strCourseID As String, strStudentID As String
    Dim strScore As String
    '用来存放文件扩展名的字符串
    Dim strExtenName As String
    
    '定义Word对象
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    
    '定义Excel对象
    Dim objExcel As Excel.Application '定义Excel对象
    Dim objWorkBook As Excel.Workbook '定义工作薄
    Dim objSheet As Excel.Worksheet '定义工作表
    Dim objRange As Excel.Range '定义用户使用工作表的范围
    
    On Error GoTo err
    iFileNumber = FreeFile
    
    '此处最好用批量更新的方式，在添加完毕一起更新
    '如果添加过程中出现错误，那么这此录入工作就彻底不完成
    '需要设置RecordSet的游标类型和锁定方式
    rsScoreInfo.Close
    rsScoreInfo.CursorLocation = adUseClient
    rsScoreInfo.LockType = adLockBatchOptimistic
    rsScoreInfo.Open
    '以上是打开文件的一些准备工作
    '*********************************************************
    
    With comDLgOpen
        .Filter = "Txt(*.txt)|*.txt|Word(*.doc)|*.doc" & _
            "|Excel(*.xls)|*.xls|All(*.*)|*.*"
        .ShowOpen
        strPath = .FileName
    End With
    
    '读入文件的时候，设置鼠标形状为沙漏
    '在MDI窗体的闲置的状态栏面板上写上对应的信息
    Screen.MousePointer = vbHourglass
    frmMainMDI.staMainMdi.Panels(2).Text = "正在写入文件，请等待......"
    
    If strPath <> vbNullString Then