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

zhaogang1960

YincyHe 发表于 2013-6-3 16:40
谢谢老师的多次回答，这个确实没法用update来更新的，因为它就是有重复的，所以我自己用了另外的方法，就 ...

你提供的3个字段判断似乎不够，存在重复记录，使用什么方法都不好更新，建议再加一个字段作为条件，以排除重复

YincyHe

zhaogang1960 发表于 2013-6-3 16:43
你提供的3个字段判断似乎不够，存在重复记录，使用什么方法都不好更新，建议再加一个字段作为条件，以排除 ...

这个没有办法，只能用这三个字段，所以就无法更新了

zhaogang1960

YincyHe 发表于 2013-6-3 16:44
这个没有办法，只能用这三个字段，所以就无法更新了

如果有重复，可考虑用逐条记录更新的方法，每次仅更新一个记录，稍候我研究一下

zhaogang1960

YincyHe 发表于 2013-6-3 16:44
这个没有办法，只能用这三个字段，所以就无法更新了

1. Sub 更新插入数据()
   
2.     Dim cnn As Object, rs As Object, SQL$
   
3.     Dim arr, i&, t$, d As Object, ds As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set ds = CreateObject("scripting.dictionary")
   
6.     arr = [a1].CurrentRegion
   
7.     Set cnn = CreateObject("adodb.connection")
   
8.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb"
   
9.     For i = 2 To UBound(arr)
   
10.         t = arr(i, 1) & Chr(9) & arr(i, 2)
    
11.         d(t) = d(t) + 1 '记录工作表中LastName和FirstName出现的次序
    
12.         SQL = "select * from Sheet1 where LastName='" & arr(i, 1) & "' and  FirstName='" & arr(i, 2) & "'"
    
13.         Set rs = CreateObject("adodb.Recordset")
    
14.         rs.Open SQL, cnn, 1, 3
    
15.         If rs.RecordCount = 0 Then
    
16.             rs.AddNew
    
17.             For j = 1 To 7
    
18.                 rs.Fields(j - 1).Value = arr(i, j)
    
19.             Next j
    
20.             rs.Update
    
21.         Else
    
22.             t = rs.Fields(0).Value & Chr(9) & rs.Fields(1).Value
    
23.             ds(t) = ds(t) + 1 '记录数据库中LastName和FirstName出现的次序
    
24.             If ds(t) = d(t) Then '如果两个出现次序相同,则更新改记录
    
25.                 For j = 3 To 7
    
26.                     rs.Fields(j - 1).Value = arr(i, j)
    
27.                 Next j
    
28.                 rs.Update
    
29.             End If
    
30.         End If
    
31.     Next
    
32. 
    
33.     MsgBox "数据保存完毕！", vbInformation + vbOKOnly
    
34.     rs.Close
    
35.     cnn.Close
    
36.     Set rs = Nothing
    
37.     Set cnn = Nothing
    
38. End Sub
    
39. 
    
40. 
    
41. 
    

复制代码

zhaogang1960

test.rar (31.52 KB, 下载次数: 63)

2013-6-3 17:18 上传

点击文件名下载附件

zhaogang1960

改进一下：

1. Sub 更新插入数据()
   
2.     Dim cnn As Object, rs As Object, SQL$
   
3.     Dim arr, i&, t$, d As Object, ds As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = [a1].CurrentRegion
   
6.     Set cnn = CreateObject("adodb.connection")
   
7.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb"
   
8.     For i = 2 To UBound(arr)
   
9.         t = arr(i, 1) & Chr(9) & arr(i, 2)
   
10.         d(t) = d(t) + 1 '记录工作表中LastName和FirstName出现的次序
    
11.         SQL = "select * from Sheet1 where LastName='" & arr(i, 1) & "' and  FirstName='" & arr(i, 2) & "'"
    
12.         Set rs = CreateObject("adodb.Recordset")
    
13.         rs.Open SQL, cnn, 1, 3
    
14.         If rs.RecordCount Then
    
15.             Set ds = CreateObject("scripting.dictionary")
    
16.             For l = 1 To rs.RecordCount
    
17.                 t = rs.Fields(0).Value & Chr(9) & rs.Fields(1).Value
    
18.                 ds(t) = ds(t) + 1 '记录数据库中LastName和FirstName出现的次序
    
19.                 If ds(t) = d(t) Then '如果两个出现次序相同,则更新改记录
    
20.                     For j = 1 To 7
    
21.                         rs.Fields(j - 1) = arr(i, j)
    
22.                     Next j
    
23.                     rs.Update
    
24.                     Exit For
    
25.                 End If
    
26.                 rs.movenext
    
27.             Next
    
28.         End If
    
29.     Next
    
30.    
    
31.     SQL = "select a.* from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) _
    
32.         & "] a left join Sheet1 b on a.LastName=b.LastName and a.FirstName=b.FirstName  where b.LastName is null"
    
33.     Set rs = CreateObject("adodb.recordset")
    
34.     rs.Open SQL, cnn, 1, 3
    
35.     If rs.RecordCount Then
    
36.         SQL = "insert into Sheet1 " & SQL
    
37.         cnn.Execute SQL
    
38.         MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation
    
39.     Else
    
40.          MsgBox "工作表的数据数据库中已经存在。", vbInformation
    
41.     End If
    
42.    
    
43.     rs.Close
    
44.     cnn.Close
    
45.     Set rs = Nothing
    
46.     Set cnn = Nothing
    
47. End Sub
    
48. 
    
49. 
    
50. 
    

复制代码

zhaogang1960

请看附件
test.rar (32.65 KB, 下载次数: 153)

2013-6-3 17:49 上传

点击文件名下载附件

YincyHe

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

真的是太感谢老师您了！

庞文

又从ZHAO大哥贴子中学习了,有问题想请教下,如数据不是保存在SHEET1中,而是另有名称,如SHEET("123")
原代码SQL = "insert into Sheet1 " & SQL,是改成SQL = "insert intoSHEET("123")" & SQL么

zhaogang1960

庞文 发表于 2013-8-30 22:57
又从ZHAO大哥贴子中学习了,有问题想请教下,如数据不是保存在SHEET1中,而是另有名称,如SHEET("123")
原代码 ...

Sheet1是数据库中的数据表，不能用intoSHEET("123")表示，数据表名可以是123：
SQL = "insert into 123 " & SQL