Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 9478|回复: 7

[已解决]如何读取access数据库表中的数据并保存到数据库另一表中 ???

[复制链接]
发表于 2013-10-19 17:15 | 显示全部楼层 |阅读模式
各位老师:
1.附档数据文件库为 Hrdatabase.accdb有两个表:一为“厂商价格”,另一为“汇率换算”
2.附档excel文件“导入数据1.xlsm“中的“导入数据”按钮,可选择要导入的excel数据“12.xlsx”到数据库表“厂商价格”中去
问题:在导入时要求依不同币别把对应的汇率(汇率来自数据库表“汇率换算”中)也保存到“厂商价格”表的字段“currate”中
现在我试了很多次都无法把对应的“汇率”保存到数据库中,不知代码错在哪里了,请各位老师帮忙解决,谢谢


最佳答案
2013-10-19 17:52
  1. Private Sub SaveTo正式价格()
  2.     On Error Resume Next
  3.     Dim ws As Worksheet

  4.     Dim Cnn As New ADODB.Connection
  5.     Dim Rst As New ADODB.Recordset
  6.     Dim SQL As String
  7.     Dim i
  8.     Dim j
  9.     Dim Pricedata


  10.     Set ws = ThisWorkbook.Worksheets("正式价格")
  11.     With Cnn
  12.         .Mode = adModeReadWrite
  13.         .CursorLocation = adUseClient
  14.         .Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\HRdatabase.accdb" & ";jet oledb:database password=" & "danysy"
  15.     End With

  16.     SQL = "SELECT * FROM 厂商价格"
  17.     Rst.Open SQL, Cnn, adOpenKeyset, adLockOptimistic

  18.     i = 2
  19.     Do While Not IsEmpty(ws.Cells(i, 1))
  20.         With Rst
  21.             .AddNew
  22.             .Fields("物料编号") = ws.Cells(i, 1)
  23.             .Fields("品牌") = LCase(ws.Cells(i, 2))    '将“品牌”、“供应商”变为小写
  24.             ' .Fields("价格") = ws.Cells(i, 3) '此句放到“单位”后,“价格”自动转换成KPC的价格
  25.             .Fields("币别") = ws.Cells(i, 4)

  26.             '------------------------------------------
  27.             Dim Rate1
  28.             Dim SQL1 As String
  29.             Dim Rst1 As New ADODB.Recordset
  30.             SQL1 = "select * from 汇率换算 where 币别名称='" & ws.Cells(i, 4) & " '"
  31.             Rst1.Open SQL1, Cnn, adOpenKeyset, adLockOptimistic
  32.             Rate1 = Rst1.Fields("汇率")
  33.             Debug.Print Rate1, SQL1
  34.             '-----------------------------------------------

  35.             .Fields("含税与否") = ws.Cells(i, 5)
  36.             .Fields("税率") = ws.Cells(i, 6)
  37.             .Fields("单位") = "KPC"    '单位全部自动转成“KPC”,原为ws.Cells(i, 7)
  38.             .Fields("价格") = IIf(ws.Cells(i, 7) = "PCS" Or ws.Cells(i, 7) = "pcs", Val(ws.Cells(i, 3) * 1000), ws.Cells(i, 3))
  39.             .Fields("MOQ") = ws.Cells(i, 8)
  40.             .Fields("SPQ") = ws.Cells(i, 9)
  41.             .Fields("Leadtime") = ws.Cells(i, 10)
  42.             .Fields("原产地") = ws.Cells(i, 11)
  43.             .Fields("价格到期日") = ws.Cells(i, 12)
  44.             .Fields("供应商") = LCase(ws.Cells(i, 13))
  45.             .Fields("价格条件") = ws.Cells(i, 14)
  46.             .Fields("付款条件") = ws.Cells(i, 15)
  47.             .Fields("报价日期") = ws.Cells(i, 16)
  48.             .Fields("备注") = ws.Cells(i, 17)
  49.             .Fields("最新价格") = "new"
  50.             .Fields("录入日期") = Date
  51.             .Fields("操作账号") = Worksheets("主画面").[b43]
  52.             .Fields("currate") = Val(Rate1)
  53.             .Update
  54.             Rst1.Close
  55.         End With
  56.         i = i + 1
  57.     Loop


  58.     Rst.Close
  59.     Cnn.Close
  60.     Set Rst = Nothing
  61.     Set Rst1 = Nothing
  62.     Set Cnn = Nothing
  63.     Set ws = Nothing
  64. End Sub
复制代码

新建文件夹.rar

387.22 KB, 下载次数: 231

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2013-10-19 17:35 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2013-10-19 17:41 | 显示全部楼层
hwc2ycy 发表于 2013-10-19 17:35
你仔细找下,有个变量名写错了。

hwc2ycy老师,
首先非常感谢您一直的指点了。
是有个变量名写错了Rs1应该是Rst1,但改了后还是不对,所有币别的汇率为1是不对的,只的RMB的汇率为1,其他的不是了
回复

使用道具 举报

发表于 2013-10-19 17:52 | 显示全部楼层    本楼为最佳答案   
  1. Private Sub SaveTo正式价格()
  2.     On Error Resume Next
  3.     Dim ws As Worksheet

  4.     Dim Cnn As New ADODB.Connection
  5.     Dim Rst As New ADODB.Recordset
  6.     Dim SQL As String
  7.     Dim i
  8.     Dim j
  9.     Dim Pricedata


  10.     Set ws = ThisWorkbook.Worksheets("正式价格")
  11.     With Cnn
  12.         .Mode = adModeReadWrite
  13.         .CursorLocation = adUseClient
  14.         .Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\HRdatabase.accdb" & ";jet oledb:database password=" & "danysy"
  15.     End With

  16.     SQL = "SELECT * FROM 厂商价格"
  17.     Rst.Open SQL, Cnn, adOpenKeyset, adLockOptimistic

  18.     i = 2
  19.     Do While Not IsEmpty(ws.Cells(i, 1))
  20.         With Rst
  21.             .AddNew
  22.             .Fields("物料编号") = ws.Cells(i, 1)
  23.             .Fields("品牌") = LCase(ws.Cells(i, 2))    '将“品牌”、“供应商”变为小写
  24.             ' .Fields("价格") = ws.Cells(i, 3) '此句放到“单位”后,“价格”自动转换成KPC的价格
  25.             .Fields("币别") = ws.Cells(i, 4)

  26.             '------------------------------------------
  27.             Dim Rate1
  28.             Dim SQL1 As String
  29.             Dim Rst1 As New ADODB.Recordset
  30.             SQL1 = "select * from 汇率换算 where 币别名称='" & ws.Cells(i, 4) & " '"
  31.             Rst1.Open SQL1, Cnn, adOpenKeyset, adLockOptimistic
  32.             Rate1 = Rst1.Fields("汇率")
  33.             Debug.Print Rate1, SQL1
  34.             '-----------------------------------------------

  35.             .Fields("含税与否") = ws.Cells(i, 5)
  36.             .Fields("税率") = ws.Cells(i, 6)
  37.             .Fields("单位") = "KPC"    '单位全部自动转成“KPC”,原为ws.Cells(i, 7)
  38.             .Fields("价格") = IIf(ws.Cells(i, 7) = "PCS" Or ws.Cells(i, 7) = "pcs", Val(ws.Cells(i, 3) * 1000), ws.Cells(i, 3))
  39.             .Fields("MOQ") = ws.Cells(i, 8)
  40.             .Fields("SPQ") = ws.Cells(i, 9)
  41.             .Fields("Leadtime") = ws.Cells(i, 10)
  42.             .Fields("原产地") = ws.Cells(i, 11)
  43.             .Fields("价格到期日") = ws.Cells(i, 12)
  44.             .Fields("供应商") = LCase(ws.Cells(i, 13))
  45.             .Fields("价格条件") = ws.Cells(i, 14)
  46.             .Fields("付款条件") = ws.Cells(i, 15)
  47.             .Fields("报价日期") = ws.Cells(i, 16)
  48.             .Fields("备注") = ws.Cells(i, 17)
  49.             .Fields("最新价格") = "new"
  50.             .Fields("录入日期") = Date
  51.             .Fields("操作账号") = Worksheets("主画面").[b43]
  52.             .Fields("currate") = Val(Rate1)
  53.             .Update
  54.             Rst1.Close
  55.         End With
  56.         i = i + 1
  57.     Loop


  58.     Rst.Close
  59.     Cnn.Close
  60.     Set Rst = Nothing
  61.     Set Rst1 = Nothing
  62.     Set Cnn = Nothing
  63.     Set ws = Nothing
  64. End Sub
复制代码
回复

使用道具 举报

发表于 2013-10-19 17:54 | 显示全部楼层
RECORDSET打开后,再次使用OPEN时必须先关闭。
用习惯了ON ERROR RESUME NEXT后,所有的错误都忽视了。
所以,代码的运行错误都没有注意到。

回复

使用道具 举报

 楼主| 发表于 2013-10-19 18:02 | 显示全部楼层
hwc2ycy 发表于 2013-10-19 17:54
RECORDSET打开后,再次使用OPEN时必须先关闭。
用习惯了ON ERROR RESUME NEXT后,所有的错误都忽视了。
所 ...

hwc2ycy老师,
您真的太厉害了,向您敬礼,辛苦了,谢谢
回复

使用道具 举报

发表于 2013-10-19 18:18 | 显示全部楼层
danysy 发表于 2013-10-19 18:02
hwc2ycy老师,
您真的太厉害了,向您敬礼,辛苦了,谢谢


有问题多发贴,解决问题就是学习的过程。
回复

使用道具 举报

 楼主| 发表于 2013-10-19 18:20 | 显示全部楼层
hwc2ycy 发表于 2013-10-19 18:18
有问题多发贴,解决问题就是学习的过程。

是的,从您身上学到了不少,谢谢
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 05:25 , Processed in 0.636690 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表