ACCESS导入Excel数据(已在6楼解决)

henrylam

1. Private Sub 路径_DblClick(Cancel As Integer)
   
2. Dialog1.ShowOpen '显示打开文件对话框
   
3. 路径.Value = Dialog1.FileName
   
4. 店铺名称.Value = "客户王"
   
5. End Sub
   
6. Private Sub Command85_Click()
   
7. On Error GoTo Err_Command85_Click
   
8. DoCmd.SetWarnings False
   
9. Dim conn
   
10. Set conn = CreateObject("ADODB.Connection")
    
11. conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Extended properties=Excel 8.0;Data Source= " & 路径.Value
    
12. SQL = "select 产品,规格1,规格2,规格3,小计 from [订单$] Where 小计 <> 0 "
    
13. Set rs = conn.Execute(SQL)
    
14. While Not rs.EOF
    
15.       SQL = "insert into 订单明细([店铺名称],[产品],[规格1],[规格2],[规格3],[小计]) values('" & 店铺名称.Value & "','" & rs(0) & "','" & rs(1) & "','" & rs(2) & "','" & rs(3) & "','" & rs(4) & "')"
    
16.       DoCmd.RunSQL SQL
    
17.       rs.MoveNext
    
18. Wend
    
19. conn.Close
    
20. Set conn = Nothing
    
21. DoCmd.SetWarnings True
    
22. MsgBox "OK"
    
23. 
    
24. Exit_Command85_Click:
    
25.     Exit Sub
    
26. Err_Command85_Click:
    
27.     MsgBox Err.Description
    
28.     Resume Exit_Command85_Click
    
29. End Sub

复制代码

网上找到一些资料改好了,虽然能达到目的,但感觉一条记录一条记录追加在数据量大时比较慢
想改为insert into select来一次实现,但不成功,哪位大大有空帮看下,或者有没有其它更高效的方式?

[ 本帖最后由 henrylam 于 2011-7-15 19:31 编辑 ]

henrylam

大侠老师们有没这方面的代码或实例

zhangjimfu

1. Sub UpdateX(sRow As Integer)
   
2.     Dim dbs As Database, sql$, mth$
   
3.     On Error Resume Next
   
4.     mth = Choose(sRow, "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
   
5.     Set dbs = OpenDatabase("F:\门店会计工作规划\PYStoreManagerV3.0.mdb")
   
6.     sql = "Update tblTempUpload as a," & "tblPLValues" & " as b Set b." & mth & "=a.Cost" & _
   
7.           " Where a.FinYear=b.FinYear and a.FinMonth=" & sRow & " and a.StoreNumber=b.StoreNumber" & _
   
8.            " and a.AccountSubject=b.AccountSubject and a.BudgetOrFact=b.BudgetOrFact"
   
9.     dbs.Execute sql
   
10.     sql = "Update tblTempUpload as a," & "tblBSValues" & " as b Set b." & mth & "=a.Cost" & _
    
11.           " Where a.FinYear=b.FinYear and a.FinMonth=" & sRow & " and a.StoreNumber=b.StoreNumber" & _
    
12.            " and a.AccountSubject=b.AccountSubject and a.BudgetOrFact=b.BudgetOrFact"
    
13.     dbs.Execute sql
    
14.     sql = "Update tblTempUpload as a," & "tblCFValues" & " as b Set b." & mth & "=a.Cost" & _
    
15.           " Where a.FinYear=b.FinYear and a.FinMonth=" & sRow & " and a.StoreNumber=b.StoreNumber" & _
    
16.            " and a.AccountSubject=b.AccountSubject and a.BudgetOrFact=b.BudgetOrFact"
    
17.     dbs.Execute sql
    
18.     sql = "Delete * From tblTempUpload"
    
19.     dbs.Execute sql
    
20.     dbs.Close
    
21. End Sub

复制代码

zhangjimfu

1. Sub UpdatingExcel(myPath As String)
   
2.     'myPath 指Excel文件路径
   
3.     On Error Resume Next
   
4.     DoCmd.TransferSpreadsheet acImport, 8, "tblTempUpload", myPath, True, "Help!B3:j141"        '工作表区域:Help!B3:j141
   
5.     DoCmd.TransferSpreadsheet acImport, 8, "tblTempUpload", myPath, True, "Help!k3:s105"
   
6.     DoCmd.TransferSpreadsheet acImport, 8, "tblTempUpload", myPath, True, "Help!B142:j246"
   
7. End Sub

复制代码

henrylam

先感谢楼上,这种可以导Excel工作表区域的数据,但在指定字段,及设置条件时不好用
3楼那种方式会提示错误"数据库被用户'Admin'使用计算机"henrylam"置为锁定或不能打开的状态",因为数据库文件已经被独占方式打开了

[ 本帖最后由 henrylam 于 2011-7-15 10:15 编辑 ]

henrylam

代码改成这样可以了

1. Private Sub 路径_DblClick(Cancel As Integer)
   
2. Dialog1.ShowOpen '显示打开文件对话框
   
3. 路径.Value = Dialog1.FileName
   
4. 店铺名称.Value = "客户王"
   
5. End Sub
   
6. 
   
7. Private Sub Command85_Click()
   
8. On Error GoTo Err_Command85_Click
   
9. DoCmd.SetWarnings False
   
10. 店铺名称.SetFocus
    
11. strname = 店铺名称.Text
    
12. SQL = "insert into 订单明细([店铺名称],[产品],[规格1],[规格2],[规格3],[小计]) select '" & strname & "',产品,规格1,规格2,规格3,小计 from [Excel 8.0;Database=" & 路径.Value & "].[订单$] where 小计 <> 0"
    
13. DoCmd.RunSQL SQL
    
14. DoCmd.SetWarnings True
    
15. MsgBox "OK"
    
16. 
    
17. Exit_Command85_Click:
    
18.     Exit Sub
    
19. Err_Command85_Click:
    
20.     MsgBox Err.Description
    
21.     Resume Exit_Command85_Click
    
22. End Sub

复制代码

[ 本帖最后由 henrylam 于 2011-7-15 19:30 编辑 ]