import.frm

哈哈

           mulu = fname & "\按考场导出"
           MkDir mulu
           Set tempbanji = New ADODB.Recordset
           tempbanji.Open "select distinct [考场] from result order by [考场] asc", daochuconn, adOpenDynamic, adLockPessimistic
           
           While tempbanji.EOF = False
                 '查找相应的地点
                 
                 Set linshi = New ADODB.Recordset
                 sql = "select [考场地点] from exam where [考场名称]='" & tempbanji.Fields("考场") & "'"
                 linshi.Open sql, daochuconn, adOpenDynamic, adLockPessimistic
                 wenjianming = mulu & "\" & tempbanji.Fields("考场") & ".xls"
                 FileCopy wenjianpath & "model\temp.xls", wenjianming
                 Set sourceconn = New ADODB.Connection
                 sourceconn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & wenjianming & ";Extended Properties=""Excel 8.0;"""
                 sourceconn.Open                      '循环打开已经分配考号的班级
                 Set daochurs = New ADODB.Recordset
                 sql = "select * from result where [考场]='" & tempbanji.Fields("考场") & "' order by [考号] asc"
                 daochurs.Open sql, daochuconn, adOpenDynamic, adLockPessimistic
                 daochurs.MoveFirst
                 Set temprs = New ADODB.Recordset
                 temprs.Open "Select * from [sheet1$]", sourceconn, adOpenDynamic, adLockPessimistic
                 While daochurs.EOF = False
                    temprs.AddNew
                    temprs.Fields("考号") = daochurs.Fields("考号")
                    temprs.Fields("姓名") = daochurs.Fields("姓名")
                    temprs.Fields("学号") = daochurs.Fields("学号")
                    temprs.Fields("成绩") = daochurs.Fields("成绩")
                    temprs.Fields("考生班级") = daochurs.Fields("班级")
                    temprs.Fields("考场地点") = linshi.Fields("考场地点")
                    temprs.Fields("考场名称") = tempbanji.Fields("考场")
                    daochurs.MoveNext
                    temprs.Update
                    jindu.Value = jindu.Value + 1
                    If jindu.Value = jindu.Max Then
                       jindu.Visible = False
                    End If
                 Wend
                    tempbanji.MoveNext
                                   temprs.close
                                   daochurs.close
                               Set daochurs = Nothing
                               Set temprs = Nothing
                Wend
        
        
        End If
                        If MsgBox("数据已经成功导出到EXCEL表格中,您现在是否要查看？", vbYesNo + 64, title) = vbYes Then
                           Dim myie As InternetExplorer
                           Set myie = New InternetExplorer
                               myie.Navigate mulu
                               myie.Visible = True
                         End If
                     
End Sub

Private Sub menuexit_Click()
   End
End Sub

Private Sub menuimport_Click()
       
       resulttree.Visible = False '隐藏结果树
       resultgrid.Visible = False '++++++++++++++++++++++++++++++++++++++++++++++
       For t = 0 To 2
         biaoqian1(t).Visible = True
       Next
         biaoqian1(3).Visible = False
         listview1.Visible = True
        
       Call import  '导入数据

  
  
End Sub

Private Sub menukaohao_Click()
  kaohaopaixu
End Sub

Private Sub menusetting_Click()
    setting.Show
    Call setting.showjilu
    resulttree.Nodes.Clear     '清空结果树
    resulttree.Visible = False '隐藏结果树
    StatusBar1.Panels(2).Text = "当前用户操作：" & " 设置考场属性..."
End Sub

Private Sub menushuxing_Click()
    resultgrid.Visible = False
End Sub



Private Sub resultgrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
       If Button = vbRightButton Then
       PopupMenu menupaixu
    End If
End Sub

Private Sub resulttree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
       PopupMenu menupaixu
    End If
End Sub

Private Sub resulttree_NodeClick(ByVal Node As MSComctlLib.Node)
 StatusBar1.Panels(2).Text = "客户当前动作：" & Node & "被客户选中......."  '状态栏提示
End Sub

Private Sub Timer1_Timer()
   StatusBar1.Panels(1).Text = "当前登录时间为： " & Now()
End Sub

Private Sub Timer2_Timer()
    If statfp Then
       StatusBar1.Panels(2).Text = "欢迎使用学生考号分配系统......."
     Else
       StatusBar1.Panels(2).Text = "愿我们的努力可以换来您工作和学习的轻松...."
     End If
     statfp = Not statfp
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key   '判断所点击的工具条上的按钮
           
           Case "import"
                menuimport_Click
           Case "setting"
                setting.Show
                StatusBar1.Panels(2).Text = "当前用户操作：" & " 设置考场属性..."
           Case "clear"
                setempty '调用自定义清空数据库过程
        
                  MsgBox "成功删除临时数据！", vbOKOnly + 64, title
           Case "create"
                 menucreate_Click
           Case "daochu"
                 menudaochu_Click
           Case "help"
                menubangzhu_Click
           Case "about"
                 menuabout_Click
           Case "exit"
                End
    End Select
End Sub


Public Sub setempty() '定义一个清空数据库的过程，方便多次进行调用
   Dim rs As ADODB.Recordset
   Set pubconn = New ADODB.Connection                '重新连接，获取最新数据
   pubconn.ConnectionString = pubconnstr
   pubconn.Open
   label1.Visible = True
   jindu.Value = 0
   jindu.Max = 9
   jindu.Visible = True
   Set rs = New ADODB.Recordset
   rs.Open "delete * from import", pubconn, adOpenDynamic, adLockPessimistic              '清空导入数据表
   jindu.Value = jindu.Value + 1
   label1.Caption = "正在清空导入的数据表......."
   StatusBar1.Panels(2).Text = "正在清空导入的数据表......."
   Set rs = New ADODB.Recordset
   rs.Open "delete * from temp", pubconn, adOpenDynamic, adLockPessimistic          '清空临时数据表
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空临时使用的数据表......."
   label1.Caption = "正在清空临时使用的数据表......."
   Set rs = New ADODB.Recordset
   rs.Open "delete * from result", pubconn, adOpenDynamic, adLockPessimistic  '清空结果数据表
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空存储操作结果的数据表......."
   label1.Caption = "正在清空存储操作结果的数据表......."
   Set rs = New ADODB.Recordset
   rs.Open "delete * from exam", pubconn, adOpenDynamic, adLockPessimistic
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空存储考场的数据表......."
   label1.Caption = "正在清空存储考场的数据表......."
   importtree.Nodes.Clear
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空导入树形列表......."
   label1.Caption = "正在清空导入树形列表......."
   resulttree.Nodes.Clear
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空选定信息树形列表......."
   label1.Caption = "正在清空选定信息树形列表......."
   finishtree.Nodes.Clear
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在清空入选人员的树形列表......."
   label1.Caption = "正在清空入选人员的树形列表......."
   setting.kaochangtree.Nodes.Clear
   resultgrid.Visible = False
   resulttree.Visible = False
   importtree.Visible = True
   listview1.Visible = True
   finishtree.Visible = True
   jindu.Value = jindu.Value + 1
   StatusBar1.Panels(2).Text = "正在初始化树形列表......."
   label1.Caption = "正在初始化树形列表......."
   exambiaoshi = ""
   pxfs = ""
   examstunum = 0
   examclassnum = 0
   listview1.ColumnHeaders.Clear
   jindu.Value = jindu.Value + 1
   jindu.Visible = False
   jindu.Value = 0
   StatusBar1.Panels(2).Text = "数据库已经完全清空......."
   label1.Caption = "数据库已经完全清空......."
   label1.Visible = False
End Sub


Public Sub deletestu()      '删除单个学生方法
Dim saveimport As ADODB.Recordset '创建数据集将删除的数据恢复到导入表
Dim delcon As ADODB.Connection ' 定义删除已选内容所需要的数据连接
Dim delrs As ADODB.Recordset
    If MsgBox("您真的要删除" & mynode.choosenode & " 吗？", vbYesNo + 64, title) = vbYes Then
       Set delcon = New ADODB.Connection
       delcon.ConnectionString = pubconnstr
       delcon.Open
       sql = "select * from temp where [班级]='" & mynode.choosefront & "' and [姓名]='" & mynode.choosenode & "';"
       Set delrs = New ADODB.Recordset
       delrs.Open sql, delcon, adOpenDynamic, adLockPessimistic
       Set saveimport = New ADODB.Recordset
       saveimport.Open "import", delcon, adOpenDynamic, adLockPessimistic
       saveimport.AddNew
       saveimport.Fields("姓名") = delrs.Fields("姓名")
       saveimport.Fields("学号") = delrs.Fields("学号")
       saveimport.Fields("成绩") = delrs.Fields("成绩")
       saveimport.Fields("班级") = delrs.Fields("班级")
       saveimport.Update
       sql = "delete * from temp where [班级]='" & mynode.choosefront & "' and [姓名]='" & mynode.choosenode & "';"
       Set delrs = New ADODB.Recordset
       delrs.Open sql, delcon, adOpenDynamic, adLockPessimistic
       keshan = True
     Else
       Exit Sub
     End If
End Sub

Public Sub deleteclass()
      Dim saveimport As ADODB.Recordset '创建数据集将删除的数据恢复到导入表
      Dim delcon As ADODB.Connection ' 定义删除已选内容所需要的数据连接
      Dim delrs As ADODB.Recordset
      jieshou = MsgBox("您真的要" & choosenode & "全部人员删除吗？", vbYesNo + 64, title)
      If jieshou = vbYes Then
         Set delcon = New ADODB.Connection
         delcon.ConnectionString = pubconnstr
         delcon.Open
         sql = "select * from temp where [班级]='" & mynode.choosenode & "'"
         Set delrs = New ADODB.Recordset
         delrs.Open sql, delcon, adOpenDynamic, adLockPessimistic
         Set saveimport = New ADODB.Recordset
         saveimport.Open "import", delcon, adOpenDynamic, adLockPessimistic
         delrs.MoveFirst
         While delrs.EOF = False
            saveimport.AddNew
            saveimport.Fields("姓名") = delrs.Fields("姓名")
            saveimport.Fields("学号") = delrs.Fields("学号")
            saveimport.Fields("成绩") = delrs.Fields("成绩")
            saveimport.Fields("班级") = delrs.Fields("班级")
            saveimport.Update
            delrs.MoveNext
          Wend
          sql = "delete * from temp where [班级]='" & mynode.choosenode & "'"
          Set delrs = New ADODB.Recordset
          delrs.Open sql, delcon, adOpenDynamic, adLockPessimistic
          keshan = True
      Else
          Exit Sub
      End If
End Sub
Public Sub resultopen()
'展示考号生成列表
resulttree.Nodes.Clear              '清空结果树
Dim finishconn As ADODB.Connection  '初始化ADO数据连接
Dim finishrs As ADODB.Recordset
Dim tempbanji As ADODB.Recordset  '定义存储班级的数据集
Set finishconn = New ADODB.Connection '实例化连接'
    finishconn.ConnectionString = pubconnstr
    finishconn.Open
    resulttree.Nodes.Clear
       '初始化入围队列
         Set dyfinish = resulttree.Nodes.Add(, , "d", "按班级排序生成结果展示", "yuanshi")
          '分别展示出每个班级被选成员
         Set tempbanji = New ADODB.Recordset
         tempbanji.Open "select distinct [班级] from temp", finishconn, adOpenDynamic, adLockPessimistic
         i = 1  '循环变量
         While tempbanji.EOF = False
               Set dyfinish = resulttree.Nodes.Add("d", tvwChild, "class" & i, tempbanji.Fields("班级"), "banji")
               
               Set finishrs = New ADODB.Recordset
               sql = "select * from result where [班级]='" & tempbanji.Fields("班级") & "' order by [考号] asc"
               finishrs.Open sql, finishconn, adOpenDynamic, adLockReadOnly
               finishrs.MoveFirst
               result = 0
                     While finishrs.EOF = False
                           result = result + 1 '防止关键字冲突，用result进行累加
                          Set dyfinish = resulttree.Nodes.Add("class" & i, tvwChild, "class" & i & result, "姓名：" & finishrs.Fields("姓名"), "xingming")
                          Set dyfinish = resulttree.Nodes.Add("class" & i & result, tvwChild, result & "k" & "class" & i, "考号:" & finishrs.Fields("考号"), "kaohao")
                          Set dyfinish = resulttree.Nodes.Add("class" & i & result, tvwChild, result & "x" & "class" & i, "学号:" & finishrs.Fields("学号"), "xuehao")
                          Set dyfinish = resulttree.Nodes.Add("class" & i & result, tvwChild, result & "c" & "class" & i, "成绩:" & finishrs.Fields("成绩"), "chengji")
                          Set dyfinish = resulttree.Nodes.Add("class" & i & result, tvwChild, result & "e" & "class" & i, "考场:" & finishrs.Fields("考场"), "kaochang")
                               finishrs.MoveNext
                               
                     Wend
                               i = i + 1 '循环变量
                               tempbanji.MoveNext
            Wend
          '展开列表
           resulttree.Nodes(1).Expanded = True
           
                                  resulttree.Visible = True