急求用VB编写调用EXCEL中的数据导入已有的ACCESS数据库表中

Sub LoadUsers()
On Error Resume Next
Screen.MousePointer = 11
Dim xlspath As String
Dim xlsConn As New ADODB.Connection
Dim xlsrs As New ADODB.Recordset
Dim sql As String
Dim totalRecords As Long

xlspath = Text1
sql = "select * from [Sheet1$]"

With xlsConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xlspath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.CommandTimeout = 5
.Open
End With

xlsrs.Open sql, xlsConn, adOpenStatic, adLockReadOnly
totalRecords = xlsrs.RecordCount

ProgressBar1.Max = totalRecords
ProgressBar1.Min = 0
ProgressBar1.Value = 0

Conn.Execute "delete from Users"

Dim i As Long
For i = 0 To totalRecords - 1
Conn.Execute "insert into Users (ID,Name,Shenfennums,Address) values(" & xlsrs("工号") & ",'" & xlsrs("员工名称") & "','" & xlsrs("身份证号码") & "','" & xlsrs("地址") & "')"
ProgressBar1.Value = ProgressBar1.Value + 1
xlsrs.MoveNext
Next

xlsrs.Close
Set xlsrs = Nothing
xlsConn.Close
Screen.MousePointer = 0
Unload Me
End Sub