EXCEL中的数据导入到access

Sub uf_TransferExcTAcc()
'===============================================================================
'-函数名称:         uf_TransferExcTAcc
'-功能描述:         将EXCEL中的数据导入到ACCESS
'-兼容*:           2000,XP,2003
'-作者:             Victor Duane
'-更新日期：        2007-10-10
'===============================================================================

Dim cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim RsIn As New ADODB.Recordset
Dim i As Integer
Dim expath As String
expath = "F:\testDB\Suki\book1.xls"
 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & expath & " ; Extended Properties=""Excel 8.0;"""

Dim exsql As String
Dim curAccPath As String

 exsql = "select *  from [sheet1$]" '查询excel语句

Rs.Open exsql, cn, adOpenKeyset, adLockPessimistic
Rs.Move (0)
RsIn.Open "select * from tblanswer", CurrentProject.Connection, 1, 3
Do Until Rs.EOF
    RsIn.AddNew
    For i = 0 To Rs.Fields.Count - 1
        RsIn(i) = Rs(i)
    Next
    Rs.MoveNext
Loop
RsIn.UpdateBatch
RsIn.Close
Rs.Close
cn.Close
Set RsIn = Nothing
Set Rs = Nothing
Set cn = Nothing
MsgBox "导入成功", , "导入...."
End Sub