find.frm

哈哈

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form find 
   Caption         =   "查找考场文件"
   ClientHeight    =   825
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3660
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   825
   ScaleWidth      =   3660
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog showfile 
      Left            =   240
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查找考场文件"
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
End
Attribute VB_Name = "find"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim pubconn As ADODB.Connection
Public Sub import()
'On Error GoTo chuli:
   Dim sql As String                   '定义SQL语句存储变量
   Dim sourcers As ADODB.Recordset     '原始数据集合
   Dim sourceconn As ADODB.Connection  '原始数据连接
   Dim importrs As ADODB.Recordset
       showfile.ShowOpen                 '查找原始数据文件
       datapath = showfile.FileName
           If datapath = "" Then
            Exit Sub
           End If
'初始化数据连接
Set sourceconn = New ADODB.Connection
    sourceconn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & datapath & ";Extended Properties=""Excel 8.0;"""
    sourceconn.Open
      '将原始数据表数据导入ACCESS表import 中
              sql = "delete * from exam"
          Set importrs = New ADODB.Recordset
              importrs.Open sql, pubconn, adOpenDynamic, adLockPessimistic
          Set importrs = New ADODB.Recordset
          Set sourcers = New ADODB.Recordset
              sourcers.Open "select * from [sheet1$]", sourceconn, adOpenStatic
              importrs.Open "exam", pubconn, adOpenDynamic, adLockPessimistic
              While sourcers.EOF = False
                importrs.AddNew
                importrs.Fields("考场名称") = sourcers.Fields("考场名称")
                importrs.Fields("考场地点") = (sourcers.Fields("考场地点"))
                importrs.Fields("考场人数") = Val(sourcers.Fields("考场人数"))
                importrs.Update
                sourcers.MoveNext
               Wend
                       importrs.close            '关闭数据库接,释放系统资源
                        Set importrs = Nothing
                            sourcers.close
                            kcszform.Show
                            Unload Me
                            
                            Exit Sub
chuli:
    MsgBox "不是有效的考场格式文件！", vbOKOnly + 48, title
    MsgBox Err.Number
    End Sub

Private Sub Form_Load()
Set pubconn = New ADODB.Connection
    pubconn.ConnectionString = pubconnstr
    pubconn.Open
Me.Visible = False
import
End Sub