根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环)

zhaogang1960

根据工作表批量更新Access数据库并向数据库添加不存在的记录时，通常可以使用AddNew、Update方法逐行判断数据库是否已经存在该记录，如果存在则更新改记录，否则插入该记录行，下面代码使用update 语句和insert into语句一次性更新已经存在的记录，插入数据库中不存在的记录：

1. Sub updateaddRecords2003()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim rs As New ADODB.Recordset
   
5.     Dim myPath As String
   
6.     Dim myTable As String
   
7.     Dim strTemp As String
   
8.     Dim arrFields As Variant
   
9. 
   
10.     myPath = ThisWorkbook.Path & "\学校管理.mdb"
    
11.     myTable = "学生档案"
    
12.     On Error GoTo errmsg
    
13.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
    
14.    
    
15.     arrFields = Range("A1:J1") '工作表中的字段名写入数组
    
16.    
    
17.     '生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……
    
18.     For i = 2 To UBound(arrFields, 2)
    
19.         strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
20.     Next
    
21.    
    
22.     '生成更新SQL语句
    
23.     SQL = "update " & myTable & " a,[Excel 8.0;Database=" & ActiveWorkbook.FullName & "].[数据$" _
    
24.         & Range("a1").CurrentRegion.Address(0, 0) & "] b set " & Mid(strTemp, 2) & " where a.学生编号=b.学生编号"
    
25.     cnn.Execute SQL '不判断，更新可能存在的“学生编号”
    
26.    
    
27.     '生成数据库不存在记录的SQL语句
    
28.     SQL = "select a.* from [Excel 8.0;Database=" & ActiveWorkbook.FullName & "].[数据$" & Range("a1").CurrentRegion.Address(0, 0) _
    
29.         & "] a left join " & myTable & " b on a.学生编号=b.学生编号 where b.学生编号 is null"
    
30.     Set rs = New ADODB.Recordset
    
31.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
32.    
    
33.     '插入数据库不存在记录
    
34.     If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
    
35.         SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
    
36.         cnn.Execute SQL
    
37.         MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation, "添加数据"
    
38.     Else
    
39.          MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
    
40.     End If
    
41.    
    
42.     '关闭连接释放内存
    
43.     rs.Close
    
44.     cnn.Close
    
45.     Set rs = Nothing
    
46.     Set cnn = Nothing
    
47.     Exit Sub
    
48. errmsg:
    
49.     MsgBox Err.Description, , "错误报告"
    
50. End Sub
    

复制代码

根据工作表批量更新数据库并向数据库添加不存在的记录(不使用循环)2003.rar (306.92 KB, 下载次数: 3693)

2013-6-3 16:30 上传

点击文件名下载附件

该贴已经同步到 zhaogang1960的微博

zhaogang1960

2007代码稍有区别：

1. '引用Microsoft ActiveX Data Objects 2.x Library
   
2. Sub updateaddRecords2007()
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim rs As New ADODB.Recordset
   
5.     Dim myPath As String
   
6.     Dim myTable As String
   
7.     Dim strTemp As String
   
8.     Dim arrFields As Variant
   
9. 
   
10.     myPath = ThisWorkbook.Path & "\学校管理.accdb"
    
11.     myTable = "学生档案"
    
12.     On Error GoTo errmsg
    
13.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
    
14.    
    
15.     arrFields = Range("A1:J1") '工作表中的字段名写入数组
    
16.    
    
17.     '生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……
    
18.     For i = 2 To UBound(arrFields, 2)
    
19.         strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
20.     Next
    
21.     '生成更新SQL语句(请注意Office2007后需要加imex=0参数)
    
22.     SQL = "update " & myTable & " a,[Excel 12.0;imex=0;Database=" & ActiveWorkbook.FullName & "].[数据$" _
    
23.         & Range("a1").CurrentRegion.Address(0, 0) & "] b set " & Mid(strTemp, 2) & " where a.学生编号=b.学生编号"
    
24.     cnn.Execute SQL '不判断，更新可能存在的“学生编号”
    
25.    
    
26.     '生成数据库不存在记录的SQL语句
    
27.     SQL = "select a.* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[数据$" & Range("a1").CurrentRegion.Address(0, 0) _
    
28.         & "] a left join " & myTable & " b on a.学生编号=b.学生编号 where b.学生编号 is null"
    
29.     Set rs = New ADODB.Recordset
    
30.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
31.    
    
32.     '插入数据库不存在记录
    
33.     If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
    
34.         SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
    
35.         cnn.Execute SQL
    
36.         MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation, "添加数据"
    
37.     Else
    
38.          MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
    
39.     End If
    
40.    
    
41.     '关闭连接释放内存
    
42.     rs.Close
    
43.     cnn.Close
    
44.     Set rs = Nothing
    
45.     Set cnn = Nothing
    
46.     Exit Sub
    
47. errmsg:
    
48.     MsgBox Err.Description, , "错误报告"
    
49. End Sub
    

复制代码

根据工作表批量更新数据库并向数据库添加不存在的记录(不使用循环)2007.rar (324.8 KB, 下载次数: 4550)

2013-6-3 16:32 上传

点击文件名下载附件

guojianlin1985

下载研究测试

abcd223143

下载收藏，赵老师作品、人品都棒。

samon_xu

谢谢分享，我要赶快学习

reverie2008

下载学习，谢谢赵老师。

xd3210

经典作品，下载学习中！

xd3210

赵兄，更新和插入新记录能否合并操作？我的思路是：先删除有的记录，再一并按新记录插入，这样执行效率是否会更高些？请指教！
(delsql="delete * from a where a.学生编号=b.学生编号",inssql= "insert into " & myTable & " " & SQL)

zhaogang1960

xd3210 发表于 2013-6-5 08:57
赵兄，更新和插入新记录能否合并操作？我的思路是：先删除有的记录，再一并按新记录插入，这样执行效率是否 ...

这种方法我用过，但delsql="delete * from a where a.学生编号=b.学生编号"好像不行，我用的是：
SQL = "delete from 数据库 where 学生编号 in(select 学生编号 from " & s & ")"

1. Sub Macro1()
   
2.     Dim cnn As New ADODB.Connection
   
3.     Dim SQL$, s$
   
4.     s = "[Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "]"
   
5.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\台帐.mdb"
   
6.     '删除数据库可能存在的工作表信息
   
7.     SQL = "delete from 数据库 where 设备编号 in(select 设备编号 from " & s & ")"
   
8.     cnn.Execute SQL
   
9. '    工作表信息追加到数据库表
   
10.     SQL = "insert into 数据库 select * from " & s
    
11.     cnn.Execute SQL
    
12.     cnn.Close
    
13.     Set cnn = Nothing
    
14. End Sub
    
15. 
    

复制代码

数据库access先删除insert存在的再insert工作表信息.rar (259.55 KB, 下载次数: 737)

2013-6-5 09:34 上传

点击文件名下载附件

xd3210

zhaogang1960 发表于 2013-6-5 09:34
这种方法我用过，但delsql="delete * from a where a.学生编号=b.学生编号"好像不行，我用的是：
SQL =  ...

谢谢赵兄！