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