|
各位老师:
1.附档数据文件库为 Hrdatabase.accdb有两个表:一为“厂商价格”,另一为“汇率换算”
2.附档excel文件“导入数据1.xlsm“中的“导入数据”按钮,可选择要导入的excel数据“12.xlsx”到数据库表“厂商价格”中去
问题:在导入时要求依不同币别把对应的汇率(汇率来自数据库表“汇率换算”中)也保存到“厂商价格”表的字段“currate”中
现在我试了很多次都无法把对应的“汇率”保存到数据库中,不知代码错在哪里了,请各位老师帮忙解决,谢谢
- Private Sub SaveTo正式价格()
- On Error Resume Next
- Dim ws As Worksheet
- Dim Cnn As New ADODB.Connection
- Dim Rst As New ADODB.Recordset
- Dim SQL As String
- Dim i
- Dim j
- Dim Pricedata
- Set ws = ThisWorkbook.Worksheets("正式价格")
- With Cnn
- .Mode = adModeReadWrite
- .CursorLocation = adUseClient
- .Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\HRdatabase.accdb" & ";jet oledb:database password=" & "danysy"
- End With
- SQL = "SELECT * FROM 厂商价格"
- Rst.Open SQL, Cnn, adOpenKeyset, adLockOptimistic
- i = 2
- Do While Not IsEmpty(ws.Cells(i, 1))
- With Rst
- .AddNew
- .Fields("物料编号") = ws.Cells(i, 1)
- .Fields("品牌") = LCase(ws.Cells(i, 2)) '将“品牌”、“供应商”变为小写
- ' .Fields("价格") = ws.Cells(i, 3) '此句放到“单位”后,“价格”自动转换成KPC的价格
- .Fields("币别") = ws.Cells(i, 4)
- '------------------------------------------
- Dim Rate1
- Dim SQL1 As String
- Dim Rst1 As New ADODB.Recordset
- SQL1 = "select * from 汇率换算 where 币别名称='" & ws.Cells(i, 4) & " '"
- Rst1.Open SQL1, Cnn, adOpenKeyset, adLockOptimistic
- Rate1 = Rst1.Fields("汇率")
- Debug.Print Rate1, SQL1
- '-----------------------------------------------
- .Fields("含税与否") = ws.Cells(i, 5)
- .Fields("税率") = ws.Cells(i, 6)
- .Fields("单位") = "KPC" '单位全部自动转成“KPC”,原为ws.Cells(i, 7)
- .Fields("价格") = IIf(ws.Cells(i, 7) = "PCS" Or ws.Cells(i, 7) = "pcs", Val(ws.Cells(i, 3) * 1000), ws.Cells(i, 3))
- .Fields("MOQ") = ws.Cells(i, 8)
- .Fields("SPQ") = ws.Cells(i, 9)
- .Fields("Leadtime") = ws.Cells(i, 10)
- .Fields("原产地") = ws.Cells(i, 11)
- .Fields("价格到期日") = ws.Cells(i, 12)
- .Fields("供应商") = LCase(ws.Cells(i, 13))
- .Fields("价格条件") = ws.Cells(i, 14)
- .Fields("付款条件") = ws.Cells(i, 15)
- .Fields("报价日期") = ws.Cells(i, 16)
- .Fields("备注") = ws.Cells(i, 17)
- .Fields("最新价格") = "new"
- .Fields("录入日期") = Date
- .Fields("操作账号") = Worksheets("主画面").[b43]
- .Fields("currate") = Val(Rate1)
- .Update
- Rst1.Close
- End With
- i = i + 1
- Loop
- Rst.Close
- Cnn.Close
- Set Rst = Nothing
- Set Rst1 = Nothing
- Set Cnn = Nothing
- Set ws = Nothing
- End Sub
复制代码
|
|