vba 用查询的结果往sccess表中新增记录

hdn1000

各位老师高人，请帮忙看看，怎么用代码将sql server数据库的查询结果写入access中，代码在窗体的加载事件，用excel，CopyFromRecordset方法可以看到记录，但access就不知道怎么操作了，请帮看看，谢谢 求助-用查询的结果集新增记录.zip (340.79 KB, 下载次数: 9)

2018-3-13 09:08 上传

点击文件名下载附件

hdn1000

Private Sub Form_Load()
Dim s$, u$, p$, d$, sql$, dd$

Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

'On Error GoTo errconn

s = "192.168.180.5": u = "sa": p = "123": d = "AIS20101124094726": dd = Me.[Text7]

cn.Open "driver=sql server;server=" & s & ";uid=" & u & ";pwd=" & p & ";database=" & d

sql = "select arrivaldate as 到达时间," _
& "t_icitem.fname as 物料," _
& "t_Supplier.fname as 供应商," _
& "POOrder.FHeadSelfP0237 as 产地," _
& "POOrder.fbillno as 订单号," _
& "POOrder.FHeadSelfP0244 as 订货指标," _
& "isnull(POInStock.fbillno,'') as 收料通知单号," _
& "isnull(POInStockEntry.FEntrySelfP0341,'') as 火车号船号," _
& "carno as 汽车号," _
& "floor(isnull(PreNetWeight,0)) as 预报重量," _
& "isnull(GrossDate,0) as 初次称重时间," _
& "floor(isnull(GrossWeight,0)) as 初重," _
& "isnull(EmptyDate,0) as 二次称重时间," _
& "floor(isnull(EmptyWeight,0)) as 末重," _
& "floor(isnull(NetWeight, 0)) As 净重" _
& " from t_zg_weight" _
& " left join t_icitem on t_icitem.fitemid=t_zg_weight.itemid" _
& " left join POOrder on POOrder.finterid=t_zg_weight.poid" _
& " left join t_Supplier on  t_Supplier.fitemid=POOrder.fsupplyid" _
& " left join POInStock on POInStock.finterid=t_zg_weight.POStockid" _
& " left join POInStockEntry on POInStockEntry.finterid=POInStock.finterid" _
& " where poid Is Not Null" _
& " and convert(varchar(100),arrivaldate,111)  ='" & dd & "'"

Set rs = (cn.Execute(sql))


If rs.RecordCount > 0 Then
    Do Until rs.EOF
        sql = "insert into T_到厂原料(到达时间,物料,供应商,产地,订单号,订货指标, 收料通知单号,火车号船号,汽车号,预报重量,初次称重时间,初重,末次称重时间,末重,净重)" _
        & "values('" & rs(0) & "','" & rs(1) & "','" & rs(2) & "','" & rs(3) & "'," & rs(4) & ",'" & rs(5) & "'," & rs(6) & ",'" & rs(7) & "','" & rs(8) & "'," _
        & rs(9) & ",'" & rs(10) & "'," & rs(11) & ",'" & rs(12) & "'," & rs(13) & "," & rs(14)
    Loop
End If


cn.Close
Set cn = Nothing
Set rs = Nothing
Exit Sub
'errconn:
'MsgBox Err.Description
'Err.Clear


End Sub

活在理想的世界

1.可以装进数组，方法arr = WorksheetFunction.Transpose(Con.Execute(Sql).GetRows)，然后将数组内容循环插入Access

2.使用Recordset的Fields,Fields是从0开始的，表达方式是Fields(0).Value；Fields(1).Value,0就是第1列，1就是第2列。。。。。。。。当然可以写成Fields(0)，Fields(1)
3.用RecordCount来确定行数

不过循环的时候注意要是有MoveNext来给指针定位。

活在理想的世界

for i = 1 to RS.RecordCount
        sql = "insert into T_到厂原料(到达时间,物料,供应商,产地,订单号,订货指标, 收料通知单号,火车号船号,汽车号,预报重量,初次称重时间,初重,末次称重时间,末重,净重)" _
        & "values('" & rs.Fields.(0) & "','" & rs.Fields(1) & "','" & rs.Fields(2) & "','" & rs.Fields(3) & "'," & rs.Fields(4) & ",'" & rs.Fields(5) & "'," & rs.Fields(6) & ",'" & rs.Fields(7) & "','" & rs.Fields(8) & "'," _
        & rs.Fields(9) & ",'" & rs.Fields(10) & "'," & rs.Fields(11) & ",'" & rs.Fields(12) & "'," & rs.Fields(13) & "," & rs.Fields(14)
RS.MoveNext
NEXT

大概是这样的结构

hdn1000

活在理想的世界 发表于 2018-3-13 10:02
for i = 1 to RS.RecordCount
        sql = "insert into T_到厂原料(到达时间,物料,供应商,产地,订单号, ...

您好，感谢您的耐心回复，执行是否可以写为 cnn.Execute sql 这样？下面的代码，执行后表里还是没有记录，错在哪里？还麻烦指教一下，T_到厂原料是access里的表，执行查询的语句写法是不是不一样？

hdn1000

If rs.RecordCount > 0 Then
For i = 1 To rs.RecordCount
sql = "insert into T_到厂原料(到达时间,物料,供应商,产地,订单号,订货指标, 收料通知单号,火车号船号,汽车号,预报重量,初次称重时间,初重,末次称重时间,末重,净重)" _
& "values('" & rs(0) & "','" & rs(1) & "','" & rs(2) & "','" & rs(3) & "'," & rs(4) & ",'" & rs(5) & "'," & rs(6) & ",'" & rs(7) & "','" & rs(8) & "'," _
& rs(9) & ",'" & rs(10) & "'," & rs(11) & ",'" & rs(12) & "'," & rs(13) & "," & rs(14)
cnn.Execute sql
rs.MoveNext
Next
End If

活在理想的世界

hdn1000 发表于 2018-3-13 10:34
您好，感谢您的耐心回复，执行是否可以写为 cnn.Execute sql 这样？下面的代码，执行后表里还是没有记录 ...

rs.open然后空格看参数
.标准写法

rs.Open Sql, CNN, 3, 2

hdn1000

活在理想的世界 发表于 2018-3-13 10:44
rs.open然后空格看参数
.标准写法

感谢您的回复，但改成您的格式还是没有能写入，是不是还要重新定义数据连接呢？附件在发主题时已经上传，麻烦您帮看看，怎么修改，谢谢了

活在理想的世界

这个代码我测试过的，你自己改一下吧。

我是用自己的数据测试的。。。。。。

1. Sub d()
   
2. Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset, Rec1 As New ADODB.Recordset, SQL As String, STR As String
   
3. Con.Open ("") 'SQL老规矩不多说
   
4. SQL = "" '你的查询SQL
   
5. Set Rec = New ADODB.Recordset: Set Rec1 = New ADODB.Recordset
   
6. Rec.Open SQL, Con, 3, 2
   
7. For c = 0 To Rec.Fields.Count - 1
   
8.     Rec1.Fields.Append Rec.Fields(c).Name, Rec.Fields(c).Type, Rec.Fields(c).DefinedSize
   
9. Next
   
10. Rec1.Open
    
11. For r = 1 To Rec.RecordCount
    
12. Rec1.AddNew
    
13.     For c = 0 To Rec.Fields.Count - 1
    
14.         Rec1.Fields(c) = Rec.Fields(c)
    
15.      Next
    
16.      Rec.MoveNext
    
17. Next
    
18. Rec1.MoveFirst
    
19. For i = 1 To Rec1.RecordCount
    
20.     STR = "('" & Rec1.Fields(0) & "','" & Rec1.Fields(1) & "','" & Rec1.Fields(2) & "','" & Rec1.Fields(3) & "','" & Rec1.Fields(4) & "','" & Rec1.Fields(5) & "','" & Rec1.Fields(6) & "','" & Rec1.Fields(7) & "')" '你的字段
    
21.     SQL = "insert into 表名  VALUES " & STR '你的插入SQL
    
22.     Rec1.MoveNext
    
23.     Con.Execute (SQL)
    
24. Next
    
25. End Sub

复制代码

hdn1000

活在理想的世界 发表于 2018-3-13 12:18
这个代码我测试过的，你自己改一下吧。

我是用自己的数据测试的。。。。。。

好的，非常感谢，我试试