请问?如何将excle中的多张sheet中的数据导入到access中呢?代码如下,但总是报错呀!

Question

Private Sub Command1_Click()
'将Excel中的数据导入到Access数据表中
Dim cn As New ADODB.Connection
Dim Con As New ADODB.Connection
Dim rs As New Recordset
Dim rs1 As New Recordset
Dim teacher_rs As New Recordset
Dim teacher_rs1 As New Recordset
Dim a As String
Dim b As Integer
Dim b1 As Integer
    Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=system.dll;Persist Security Info=False"
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=mm.dll;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
    cn.Open
    Con.Open
    '设法取出数据表中的最后的编号值
   rs1.Open "select * from mm ", Con, adOpenKeyset, adLockOptimistic
   If rs1.RecordCount <> 0 Then
     On Error GoTo hello1
     rs1.MoveLast
     If rs1.Fields("编号") <> "" Then
       Text2.Text = rs1.Fields("编号")
     End If
   Else
hello1:
   End If   '将取出的数值赋给b
   b = Int(Text2.Text)
   '将excel中的编号与b相加形成新编号，然后进行插入操作
    rs.Open "select * From [Sheet1$]", cn, 1, 1
    If rs.EOF = True Then
        Exit Sub
    End If
    While Not rs.EOF
        Con.Execute "Insert Into mm Values('" & rs(0) + b & "','" & rs(1) & "','" & rs(2) & "')"
        'Con.Execute "Insert Into teacher Values('" & rs(0) + b & "','" & rs(1) & "','" & rs(2) & "','" & rs(3) & "','" & rs(4) & "','" & rs(5) & "','" & rs(6) & "','" & rs(7) & "','" & rs(8) & "','" & rs(9) & "','" & rs(10) & "','" & rs(11) & "','" & rs(12) & "','" & rs(13) & "','" & rs(14) & "','" & rs(15) & "','" & rs(16) & "','" & rs(17) & "','" & rs(18) & "','" & rs(19) & "','" & rs(20) & "','" & rs(21) & "','" & rs(22) & "','" & rs(23) & "','" & rs(24) & "','" & rs(25) & "','" & rs(26) & "','" & rs(27) & "')"
        rs.MoveNext
    Wendrs.Close
rs1.Close
Set rs = Nothing    '设法取出数据表中的最后的编号值
   teacher_rs1.Open "select * from teacher ", Con, adOpenKeyset, adLockOptimistic
   If teacher_rs1.RecordCount <> 0 Then
     On Error GoTo hello11
     teacher_rs1.MoveLast
     If teacher_rs1.Fields("编号") <> "" Then
       Text2.Text = teacher_rs1.Fields("编号")
     End If
   Else
hello11:
   End If   '将取出的数值赋给b
   b1 = Int(Text2.Text)
   '将excel中的编号与b相加形成新编号，然后进行插入操作
    teacher_rs.Open "select * From [Sheet2$]", cn, 1, 1
    If teacher_rs.EOF = True Then
        Exit Sub
    End If
    While Not teacher_rs.EOF
        'Con.Execute "Insert Into mm Values('" & rs(0) + b & "','" & rs(1) & "','" & rs(2) & "')"
         Con.Execute "Insert Into teacher Values('" & teacher_rs(0) + b & "','" & teacher_rs(1) & "','" & teacher_rs(2) & "','" & teacher_rs(3) & "','" & teacher_rs(4) & "','" & teacher_rs(5) & "','" & teacher_rs(6) & "','" & teacher_rs(7) & "','" & teacher_rs(8) & "','" & teacher_rs(9) & "','" & teacher_rs(10) & "','" & teacher_rs(11) & "','" & teacher_rs(12) & "','" & teacher_rs(13) & "','" & teacher_rs(14) & "','" & teacher_rs(15) & "','" & teacher_rs(16) & "','" & teacher_rs(17) & "','" & teacher_rs(18) & "','" & teacher_rs(19) & "','" & teacher_rs(20) & "','" & teacher_rs(21) & "','" & teacher_rs(22) & "','" & teacher_rs(23) & "','" & teacher_rs(24) & "','" & teacher_rs(25) & "','" & teacher_rs(26) & "','" & teacher_rs(27) & "','" & teacher_rs(28) & "')"
        teacher_rs.MoveNext
    Wendteacher_rs.Close
teacher_rs1.Close
Set teacher_rs = Nothingcn.Close
Set cn = Nothing
Con.Close
a = MsgBox("数据导入完毕！", vbInformation, "提示")
End Sub
错误出现在这一行(倒数第19行):    teacher_rs.Open "select * From [Sheet2$]", cn, 1, 1  对象打开是不允许操作.
单关闭cn时则提出相反的错误.

Answer 1

Excel.exe在运行的话，关闭试试

Answer 2

所有的都关闭了呀！
上面的代码有问题吗？我从一张sheet上导入access中时是正确的，怎么导入多张sheet就不行了呢？

Answer 3

If teacher_rs.EOF = True Then
    Exit Sub
End If删除

Answer 4

高深，我都看不懂。
要搞得这么复杂吗，把Excel里的表导入到Access有很简单的方法。
用Excel的引用读出总共有几个Sheet，然后就直接用SQL把相应的Sheet名导入，这多块啊。
你用Insert不要半天啊。

Answer 5

高深，我都看不懂。
要搞得这么复杂吗，把Excel里的表导入到Access有很简单的方法。
用Excel的引用读出总共有几个Sheet，然后就直接用SQL把相应的Sheet名导入，这多块啊。
你用Insert不要半天啊。
能不能给出点代码呢？期待你的方法！在线等待！！！！！！！