open_excel.bas

学校机房的上机管理系统.可以安排免费上机,可以收费上机.适合中小型机房.修改后也可以作为网吧管理软件.

Attribute VB_Name = "Module1"
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                   (ByVal hWnd As Long, ByVal lpszOp As String, _
                    ByVal lpszFile As String, ByVal lpszParams As String, _
                    ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                    As Long
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Const SW_NORMAL = 1


Public Sub import_data_from_excel() '从EXCEL导入数据
Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim filename As String
 Form1.cd1.ShowOpen           'EXCEL文件名
 filename = Form1.cd1.filename
If filename = "" Then Exit Sub
With oConn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Extended Properties").Value = "Excel 8.0"
    .Open filename
End With
oRS.Open "Select * from [Sheet1$]", oConn, adOpenStatic
'检验班级是否已存在
Dim no As String
no = oRS.Fields(0).Value
no = Left(no, 7)

Form1.rec_class.Close
Form1.rec_class.Open "select * from class where class_no = " & no
If Form1.rec_class.RecordCount = 0 Then '班级不存在，则输入

'在班级表中添加一个记录
Form1.rec_class.AddNew
Form1.rec_class.Fields(0).Value = no '有班级表中插入一个班级
classname = InputBox("请输入班级名称：", "输入提示", "A03计算机1班")
Form1.rec_class.Fields(1).Value = classname
Form1.rec_class.Update
Form1.rec_class.Close
Form1.rec_class.Open "select * from class"
Do While Not (oRS.EOF)
        Form1.rec_base.AddNew
        Form1.rec_info.AddNew
        Form1.rec_count.AddNew
        For i = 0 To 1
        '在base表都中增加1学生
            Form1.rec_base.Fields(i).Value = oRS.Fields(i).Value
        Next
        '在info表中增加1学生
        Form1.rec_info.Fields(0).Value = oRS.Fields(0).Value
       Form1.rec_info.Fields(1).Value = "123456"

         '在count表中增加1学生
        Form1.rec_count.Fields(0).Value = oRS.Fields(0).Value
        Form1.rec_count.Fields(1).Value = 0
        Form1.rec_base.Update
        Form1.rec_count.Update
        Form1.rec_info.Update
        oRS.MoveNext
Loop

Else
  MsgBox "该班级已有学生存在，请个别输入", vbCritical
End If

oConn.Close
Set oConn = Nothing
End Sub