frmscoreinput.frm

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

        '获取文件的扩展名，根据扩展名来控制对不同文件的不同操作
        strExtenName = Right(strPath, 3)
        '读取文本文件
        If strExtenName = "txt" Then
            Open strPath For Input As #iFileNumber
            '对于文本文件，要求分隔符必须写清楚，每行就三个字段
            '这一点需要严格遵守，否则读取文件和写入数据库将出错
            Do While Not EOF(iFileNumber)
                Input #iFileNumber, strCourseID, strStudentID, strScore
                
                rsScoreInfo.AddNew
                rsScoreInfo("课程代号") = Trim$(strCourseID)
                rsScoreInfo("学号") = Trim$(strStudentID)
                rsScoreInfo("成绩") = CDbl(Trim$(strScore))
            Loop
            Close #iFileNumber
        End If
        
        '读取Word文档
        If strExtenName = "doc" Then
            Dim i As Integer
            
            Set objWord = New Word.Application
            '此处完全可以用以前讲过的GetObject方法来获取一个已经存在的文档
            Set objDoc = objWord.Documents.Open(strPath)
            
            '注意Words关键字，代表Word中的一个词，该词以空格为划分
            '因此，如果文档是Word格式，每个数据信息必须紧凑，不同
            '信息之间用空格分开，空格数量不限
            
            '请每行只写入3个字段的信息
            '此处的For循环，步长为4，每次就走过了一行信息。
            
            'objDoc.Words.Count是整篇Word文档的词的数量
            '利用这样的循环读取每行，需要自己通过代码
            '来控制分隔，和添加数据到数据库的时机；步长为4就是一种方法
            For i = 1 To objDoc.Words.Count Step 4
            '设定步长为4，是因为每行
            '有3个变量，和一个回车换行－－显示为空字符串
                strCourseID = Trim$(objDoc.Words(i).Text)
                strStudentID = Trim$(objDoc.Words(i + 1).Text)
                strScore = Trim$(objDoc.Words(i + 2).Text)
                
                rsScoreInfo.AddNew
                rsScoreInfo("课程代号") = Trim$(strCourseID)
                rsScoreInfo("学号") = Trim$(strStudentID)
                rsScoreInfo("成绩") = CDbl(Trim$(strScore))
            Next i
            
            '对象使用完毕后要关闭，并释放资源
            '读取Word文档中的信息还有其他的方法，在此不再介绍
            objDoc.Close
            Set objDoc = Nothing
            Set objWord = Nothing
        End If
        
        '读取Excel文档
        If strExtenName = "xls" Then
            Dim iRows As Integer '行数
            Dim iCols As Integer '列数
            
            '第一重循环，外部循环。
            '注意，完全可以利用行和列做成2重循环
            '不过，在这里，单循环就足够了
            Dim jOut As Integer
            
            Set objExcel = New Excel.Application
            Set objWorkBook = objExcel.Workbooks.Open(strPath)
            Set objSheet = objWorkBook.ActiveSheet
            
            Set objRange = objSheet.UsedRange '用户使用过的工作表范围
            '注意，上面定义用户使用过的工作范围非常重要，否则
            '将是Excel应用程序所能有的所有工作范围，那将是一个非常大的
            '范围
            '…………………………………………………………………………
            
            '取得该工作表范围内的行数以及列数（应该是3列）
            iRows = objRange.Rows.Count
            iCols = objRange.Columns.Count
            For jOut = 1 To iRows
                '控制为3列
                If iCols <> 3 Then
                    iCols = 3
                End If
                
                '读取每个单元格内的值
                strCourseID = Trim$(objSheet.Cells(jOut, iCols - 2))
                strStudentID = Trim$(objSheet.Cells(jOut, iCols - 1))
                strScore = Trim$(objSheet.Cells(jOut, iCols))
                
                rsScoreInfo.AddNew
                rsScoreInfo("课程代号") = Trim$(strCourseID)
                rsScoreInfo("学号") = Trim$(strStudentID)
                rsScoreInfo("成绩") = CDbl(Trim$(strScore))
            Next jOut
            
            '释放资源
            objWorkBook.Close
            Set objSheet = Nothing
            Set objWorkBook = Nothing
            Set objExcel = Nothing
        End If
        '由于是批量更新，因此在所有循环结束后，使用一次命令即可
        '这样，三种类型的操作可以公用这行语句
        rsScoreInfo.UpdateBatch
    End If
    
    '数据录入完成后，恢复鼠标形状，清空面板信息
    Screen.MousePointer = vbDefault
    frmMainMDI.staMainMdi.Panels(2).Text = vbNullString
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
    '发生错误，就取消更新
    rsScoreInfo.CancelBatch
    '数据录入完成后，恢复鼠标形状，清空面板信息
    Screen.MousePointer = vbNormal
    frmMainMDI.staMainMdi.Panels(2).Text = vbNullString
    
    '释放资源的时候，如果出错，则执行下面的语句
    On Error Resume Next
    objDoc.Close
    Set objDoc = Nothing
    Set objWord = Nothing
    
    objWorkBook.Close
    Set objSheet = Nothing
    Set objWorkBook = Nothing
    Set objExcel = Nothing
End Sub

Private Sub cmdStarInput_Click()
     ChangeEnabled True
End Sub

Private Sub Form_Load()
    On Error GoTo err
    '窗体被载入的时候执行一部分的初始化工作
    '为课程代号组合框添加可选择的项
    cboCourseID.Clear
    
    '取得课程信息数据表的记录集和成绩信息的记录集
    Set rsCoursesInfo = GetRecordSet(strCoursesSql)
    Set rsScoreInfo = GetRecordSet(strScoreSql)
    
    '通过一个循环，将目前所有设置的课程代号都加入到
    '组合框中，这使得录入人员在输入几个字母后即可选择到
    '正确的课程代号
    rsCoursesInfo.MoveFirst
    Do While Not rsCoursesInfo.EOF
        cboCourseID.AddItem rsCoursesInfo("课程代号")
        rsCoursesInfo.MoveNext
    Loop
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub

Private Sub txtScore_KeyPress(KeyAscii As Integer)
    Dim strCourseID As String, strStudentID As String
    Dim dblScore As Double
    
    '定义临时的记录集，用来查询重复记录
    '这也是一种很有用的查询重复记录的方法
    Dim rsTempScore As ADODB.Recordset
    Dim strTempSql As String
    
    On Error GoTo err
    '利用select case 语句写输入限制，很方便，比利用
    '多重的If嵌套要有效的多。
    Select Case KeyAscii
        Case 48 To 57   '如果是数字，则输入
        Case 46, 8      '如果是.和退格键BackSpace也能正确响应
        Case 13         '如果是回车键，则执行代码如下，进行添加记录
            strCourseID = Trim$(cboCourseID.Text)
            strStudentID = Trim$(txtStudentID.Text)
            dblScore = CDbl(Trim$(txtScore.Text))
            
            '利用查询性质的SQL语句来获得记录集，从而判断
            '是否有重复记录
            strTempSql = "select * from uScoreInfo where 课程代号=" & _
                "'" & strCourseID & "'" & " and 学号=" & "'" & strStudentID & "'"
            Set rsTempScore = GetRecordSet(strTempSql)
            
            '不能录入空字符串
            If (strCourseID <> vbNullString) And (strStudentID <> vbNullString) _
                And (Trim$(txtScore.Text) <> vbNullString) Then
                
                '如果数据库中已经存在字段，即查询结果返回不是空记录集
                '则提示输入有错误，同时释放rsTempScore所占用的资源
                If Not (rsTempScore.EOF And rsTempScore.BOF) Then
                    MsgBox "课程代号＋学号，两个字段内容不能完全重复！"
                    rsTempScore.Close
                    Set rsTempScore = Nothing
                    Exit Sub
                Else
                    '如果是查询返回一个空记录集，那么就可以执行添加
                    '首先关闭rsTempScore，释放资源
                    rsTempScore.Close
                    Set rsTempScore = Nothing
                    
                    rsScoreInfo.AddNew
                    rsScoreInfo("课程代号") = Trim$(cboCourseID.Text)
                    rsScoreInfo("学号") = Trim$(txtStudentID.Text)
                    rsScoreInfo("成绩") = CDbl(Trim$(txtScore.Text))
                    rsScoreInfo.Update
                    cboCourseID.SetFocus
                End If
            Else
                MsgBox "不能有空值！"
            End If
        Case Else       '其他的字符和键值均不响应
            KeyAscii = 0
    End Select
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub