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