Access VBA根据特定的条件，将excel表中的数据更新到Access数据库中

清风明月九 · 发表于 2013-10-7 18:09

谢谢楼主的分享！很有用啊。

mm050610 · 发表于 2013-10-7 21:27

努力学习中，谢谢分享！

ouyli · 发表于 2013-10-27 14:42

zhaogang1960 发表于 2013-6-3 17:31
请看附件

老师，如果例子中加一列时间。
由于教师可能换号码，所以需要增加最新时间的信息，把数据库里旧的信息删掉。
可不可以实现呢？

zhaogang1960 · 发表于 2013-10-27 18:27

ouyli 发表于 2013-10-27 14:42
老师，如果例子中加一列时间。
由于教师可能换号码，所以需要增加最新时间的信息，把数据库里旧的信息删 ...

请上传附件说明要求

ouyli · 发表于 2013-11-2 14:48

zhaogang1960 发表于 2013-10-27 18:27
请上传附件说明要求

test.rar (22.83 KB, 下载次数: 20)

麻烦老师了{:soso_e144:}

zhaogang1960 · 发表于 2013-11-2 15:13

ouyli 发表于 2013-11-2 14:48
麻烦老师了

Sub 更新插入数据()
Dim cnn As Object, rs As Object, SQL$
Dim arr, i&, s$, t, d As Object
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
s = arr(i, 1) & Chr(9) & arr(i, 2)
If Not d.Exists(s) Then
d(s) = i
ElseIf arr(i, 8) > arr(d(s), 8) Then
d(s) = i
End If
Next
t = d.items
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb"
For i = 0 To d.Count - 1
r = t(i)
SQL = "select * from Sheet1 where LastName='" & arr(r, 1) & "' and FirstName='" & arr(r, 2) & "'"
Set rs = CreateObject("adodb.Recordset")
rs.Open SQL, cnn, 1, 3
If rs.RecordCount = 0 Then
rs.AddNew
For j = 1 To 8
rs.Fields(j - 1).Value = arr(r, j)
Next
rs.Update
Else
For j = 3 To 8
rs.Fields(j - 1).Value = arr(r, j)
Next
rs.Update
End If
Next
MsgBox "数据保存完毕！", vbInformation + vbOKOnly
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2013-11-2 15:15

请看附件

test.rar (31.9 KB, 下载次数: 147)

ouyli · 发表于 2013-11-2 15:23

zhaogang1960 发表于 2013-11-2 15:15
请看附件

嗯，就是这样的。太感谢了。
我觉得这个可以应用到实际中去，比如建立材料价格库之类的。

tesiroys · 发表于 2014-4-4 08:36

zhaogang1960 发表于 2013-11-2 15:15
请看附件

老师，你好！请问如果我的列数增加了该如何修改参数啊？谢谢！

qangsheng · 发表于 2014-4-4 10:21

做个报价资料库是个好思路。

		自动登录	找回密码
密码			免费注册

[求助] Access VBA根据特定的条件，将excel表中的数据更新到Access数据库中