如何用VBA批量添加及更新SQL数据库中的数据

hqw35765

各位高手朋友，谁知道怎么在excel中，用VBA实现将excel工作表的数据，批量添加/修改到SQL数据库中去，数据库是SQL2008，excel是2007版。

假如，excel中得数据表名称为“sheet1”，有3列数据：学号、姓名、专业。其中，学号是唯一的，不重复。
SQL数据库名字为：mydata，表名为：mytable。 mytable中存有的数据与上述sheet1中的格式相同。
现在需要实现下述功能：
将sheet1中的数据更新至mytable中，如果经过判断，mytable中存在相同学号，则进行覆盖修改（对于同一个学号，sheet1中的其它信息可能跟SQL中不同，所以需要覆盖更新）；如果经过判断，mytable中没有相同学号，则在SQL中新增记录。

请高手帮忙，非常感谢。

opiona

1. 
   
2. Sub opiona()
   
3.     Str_coon = "Provider=SQLOLEDB.1;Data Source=OPIONA;Initial Catalog=CPECC_Temp;Uid=SA;PWD=1234;Persist Security Info=false"     '//SQLServer 2008本地链接
   
4.     'Data Source=服务器名称
   
5.     'Initial Catalog=数据库名称
   
6.     'Uid=SA 用户名
   
7.     'PWD=1234 '/密码
   
8.     Rem 通过SQLOLEDB链接Excel没有测试过，请自行测试修改！！！
   
9.     Rem 参考：SELECT * FROM OpenDataSource( 'Microsoft.ACE.OLEDB.12.0','Data Source="D:\KK.KK.xlsx";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$]
   
10.     Rem 来源：http://blog.csdn.net/kk185800961/article/details/9186335
    
11. 
    
12.     StrSQL = "DELETE FROM mytable WHERE 学号 IN ("
    
13.     StrSQL = StrSQL & "SELECT 学号 FROM ( 'Microsoft.ACE.OLEDB.12.0','Data Source=" & ThisWorkbook.FullName & ";User ID=Admin;Password=;Extended properties=Excel 12.0')...[Sheet1$]"
    
14.     StrSQL = StrSQL & ")"
    
15.     Bool_1 = AddDelMove(StrSQL, Str_coon)  '//先删除Server中在Sheet1存在的数据
    
16.     StrSQL = "INSERT INTO mytable ("
    
17.     StrSQL = StrSQL & "SELECT * FROM ( 'Microsoft.ACE.OLEDB.12.0','Data Source=" & ThisWorkbook.FullName & ";User ID=Admin;Password=;Extended properties=Excel 12.0')...[Sheet1$]"
    
18.     StrSQL = StrSQL & ")"
    
19.     Bool_1 = AddDelMove(StrSQL, Str_coon)  '//再将Sheet1存在的数据全部添加到Server
    
20. End Sub
    
21. 
    
22.    
    
23. '*****************************************************************************************
    
24. '函数名：    AddDelMove
    
25. '函数功能：  执行SQL语句，一般为添加、修改删除语句
    
26. '返回值：    返回一个布尔值，是否成功完成
    
27. '参数1：     StrSQL     字符类型   SQL查询语句
    
28. '参数2：     Str_coon   字符类型   链接语句
    
29. '使用方法： StrSQL=“update [sheet1$i8:i9] set f1='Your Pleasure”
    
30. '                     StrSQL="insert into [sheet1$k2:l6] (f1,f2) values (9,'mine')"
    
31. '                     Bool_1= AddDelMove(StrSQL, Str_coon)
    
32. '*****************************************************************************************
    
33. Public Function AddDelMove(ByVal StrSQL As String, ByVal Str_coon As String) As Boolean    '//执行SQL语句，一般为添加、修改删除语句
    
34. On Error Resume Next    ' 改变错误处理的方式。
    
35. Err.Clear
    
36.     If StrSQL = "" Then AddDelMove = False: Exit Function
    
37.         Set CN = CreateObject("Adodb.Connection") '//新建一个ADO连接
    
38.         Set RS = CreateObject("adodb.recordset")
    
39.         CN.Open Str_coon
    
40.         CN.Execute (StrSQL)
    
41.         If Err.Number <> 0 Then AddDelMove = False Else AddDelMove = True
    
42.         CN.Close  '//关闭ADO连接
    
43.     Set RS = Nothing
    
44.     Set CN = Nothing  '//释放内存
    
45. End Function
    
46. '*****************************************************************************************
    

复制代码

xww603

opiona 发表于 2015-7-20 09:42

代码报错了，能帮忙修改一下嘛，急需，求助！！！

xww603

opiona 发表于 2015-7-20 09:42

代码报错，说是incorrect syntax near 'Miscrosoft.ACE.OLEDB.12.0',您能帮忙看一下么。如果加了opendatasource依旧报错，不能执行。

opiona

1. Sub opiona()
   
2. 
   
3.    
   
4. Rem 在Excel中MSSQL和EXCEL联合查询：成功
   
5.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';Data Source =" & ThisWorkbook.FullName     '//OFFICE2007
   
6.     StrSQL = "SELECT * FROM"
   
7.     StrSQL = StrSQL & " [odbc;Driver={SQL Server};"  '//在空格+[：后面是固定格式
   
8.     StrSQL = StrSQL & "Server=FANGWEI;"              '//服务器名称或地址
   
9.     StrSQL = StrSQL & "Database=XIEXIN;"             '//数据库名称
   
10.     StrSQL = StrSQL & "UID=sa;PWD=1005]"             '//用户名，密码]
    
11.     StrSQL = StrSQL & ".USID"                        '//.[数据表名]
    
12. 
    
13.     StrSQL = StrSQL & " WHERE 编号 not IN (SELECT 编号 FROM [Sheet1$])"
    
14.     SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, True)
    
15.     Sheet2.Cells.Clear
    
16.     Sheet2.Range("A1").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
17. 
    
18. Rem 用Excel直接删除MSSQL数据表：失败
    
19. Rem 用MSSQL删除：成功
    
20.     Str_coon = "Provider=SQLOLEDB.1;Data Source=FANGWEI;Initial Catalog=XIEXIN;Uid=SA;PWD=1005;Persist Security Info=false"     '//SQLServer 2008本地链接
    
21.     StrSQL = "DELETE FROM USID"
    
22.     Bool_1 = AddDelMove(StrSQL, Str_coon)  '//先删除Server中在Sheet1存在的数据
    
23.     MsgBox Bool_1
    
24.    
    
25. Rem 添加Excel数据到SQLSERVER：成功
    
26.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';Data Source =" & ThisWorkbook.FullName     '//OFFICE2007
    
27.     StrSQL = "INSERT INTO "
    
28.     StrSQL = StrSQL & " [odbc;Driver={SQL Server};"  '//在空格+[：后面是固定格式
    
29.     StrSQL = StrSQL & "Server=FANGWEI;"              '//服务器名称或地址
    
30.     StrSQL = StrSQL & "Database=XIEXIN;"             '//数据库名称
    
31.     StrSQL = StrSQL & "UID=sa;PWD=1005]"             '//用户名，密码]
    
32.     StrSQL = StrSQL & ".USID"                        '//.[数据表名]
    
33.     StrSQL = StrSQL & " SELECT 编号,姓名,数量 FROM [Sheet1$]"  '//前面有一个空格
    
34.     Bool_1 = AddDelMove(StrSQL, Str_coon)
    
35.     MsgBox Bool_1
    
36. 
    
37. Rem 为实现你的要求，可现将Sheet1内容放入一个临时表，SQL写法见：添加Excel数据到SQLSERVER
    
38. 
    
39. Rem 删除实际表中在临时表中存在的：编号，
    
40. '    StrSQL = "DELETE FROM [实际数据表] WHERE 编号 IN [临时表]"
    
41. Rem 然后将临时表添加到实际表，SQL见：用MSSQL删除
    
42. '    StrSQL = "INSERT INTO [实际数据表] SELECT * FROM [临时表]"
    
43.    
    
44. End Sub

复制代码

opiona

Book1.rar (20.73 KB, 下载次数: 1246)

2016-8-5 13:36 上传

点击文件名下载附件

xww603

大神，太牛了！！！

huxiaoying11

麻烦问下为什么我改完后会显示如下报错呢，这个不是用不到access数据库么，谢谢大家啦~

zjhahaha

我下载了book1.xlsm，执行的时候有如下错误。望指导。谢谢

zjhahaha

终于做成功了，谢谢opiona的程序。这个只是达到了第一步，现在想要达到：每次修改，都保留修改记录，并放在另外个表里面，要求保留修改前的数据和修改后的数据，以及修改时间。谢谢。