Private Sub Command1_Click()
'工程->引用->Microsoft ActiveX Data Objects 2.X Library
On Error Resume Next
Dim i%, n%, l%
Dim Conn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Cnt As Integer
Dim xConn As New ADODB.Connection
Dim xRs As New ADODB.Recordset
Dim xCnt As Integer

Conn.CursorLocation = adUseClient
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\lzjc_Data.mdb"
If Rs.State <> adStateClosed Then Rs.Close
Rs.Open "select * from kucun", Conn, adOpenKeyset, adLockOptimistic
xConn.CursorLocation = adUseClient
'连接Excel的字符串，后面的“HDR=yes”需要注意，它的意思是把Excel表第一行作为字段名，第二行开始方是有效数据。HDR=no则反之，从第一行开始就看做有效数据。
xConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\库存.xls;Extended Properties='Excel 8.0;HDR=yes;IMEX=1'"
If xRs.State <> adStateClosed Then xRs.Close
'像打开数据库一样，使用SQL语言，打开名称为“sheet1”的工作表
xRs.Open "select * from [sheet1$]", xConn, adOpenStatic, adLockReadOnly
xCnt = xRs.RecordCount
Set Form4.DataGrid1.DataSource = xRs

If xCnt = 0 Then '因为HDR=yes，必有1行表头数据
    MsgBox "请确认“库存.xls”的“sheet1”工作簿内容不为空！否则无法导入任何数据！"
    Exit Sub
End If
ProgressBar1.Max = xCnt
ProgressBar1.Min = 0
ProgressBar1.Value = 0
Label1.Caption = "0 / " & xCnt

For i = 0 To xCnt - 1
DoEvents
'下面的SQL插入语句自行更改，注意数据格式，如果是xRs("字段名1")的值是文本，记得在两边加单引号。
Conn.Execute "insert into kucun(类别,名称,数量,进价,报警,拼码) values(" & xRs("类别") & "," & xRs("名称") & "," & xRs(数量) & " ," & xRs(进价) & "," & xRs(报警) & "," & xRs("拼码") & "  )"
xRs.MoveNext
Label1.Caption = i + 1 & " / " & xCnt
ProgressBar1.Value = i + 1
Next


End Sub