求助利用ADO方法将数据写入到另一个工作表

笨熊弟弟

求助利用ADO方法将数据写入到另一个工作表，同文件夹下两个文件，一个名称为：数据；另一个名称为：备份。
求方法，将数据表的数据写入到备份表相应的位置。
谢谢大家！



另外请教大家，现在怎么上传附件啊？上传的按钮怎么找不到的.....

笨熊弟弟

求助利用ADO方法将数据写入到另一个工作表，同文件夹下两个文件，一个名称为：数据；另一个名称为：备份。
求方法，将数据表的数据写入到备份表相应的位置。
谢谢大家！

zhaogang1960

1. Sub Macro1()
   
2.     Dim cnn As Object, SQL$
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.Path & "\备份.xls"
   
5.     SQL = "insert into [Sheet1$] select * from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[Sheet1$]"
   
6.     cnn.Execute SQL
   
7.     MsgBox "数据已经添加到数据库！", vbInformation, "添加数据"
   
8.     cnn.Close
   
9.     Set cnn = Nothing
   
10. End Sub

复制代码

zhaogang1960

请测试附件
ADO.rar (13.66 KB, 下载次数: 158)

2014-1-16 23:14 上传

点击文件名下载附件

笨熊弟弟

谢谢版主！经运行，完美达到目的！谢谢......


再请教版主，目前能备份到目的表了，但，我现在想先将备份表里面的数据清除了，再将新数据写进去，上面的代码应该怎么修改啊？

麻烦你了，真的不好意思。

zhaogang1960

笨熊弟弟 发表于 2014-1-16 23:21
谢谢版主！经运行，完美达到目的！谢谢......

ADO操作工作簿，Delete语句无效，可以做到如果姓名相同的更新、姓名不存在的插入，但要用ADO删除数据好像不行
有人用更新把所有数据都更新为空格，你先搜索一下

zhaogang1960

按照上面的方法，试试看：

1. Sub Macro1()
   
2.     Dim cnn As Object, SQL$
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.Path & "\备份.xls"
   
5.     SQL = "update [Sheet1$] set 姓名=null,班别=null,年龄=null"
   
6.     cnn.Execute SQL
   
7.     SQL = "insert into [Sheet1$] select * from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[Sheet1$]"
   
8.     cnn.Execute SQL
   
9.     MsgBox "数据已经添加到数据库！", vbInformation, "添加数据"
   
10.     cnn.Close
    
11.     Set cnn = Nothing
    
12. End Sub

复制代码

zhaogang1960

经测试，update更新为空格后，再用insert 插入数据后，那些空格将继续保留，在备份.xls 加一段程序，打开它时自动删除可能存在的空格：

1. Private Sub Workbook_Open() '备份.xls  ThisWorkbook
   
2.     Dim lr&
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     On Error Resume Next
   
6.     With Sheets("Sheet1")
   
7.         lr = .[a65536].End(xlUp).Row
   
8.         If lr > 1 Then .Range("A1:A" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
9.     End With
   
10.     Me.Save
    
11.     Application.ScreenUpdating = True
    
12. End Sub
    
13. 
    

复制代码

zhaogang1960

请测试附件
ADO.rar (14.37 KB, 下载次数: 94)

2014-1-17 00:05 上传

点击文件名下载附件

笨熊弟弟

谢谢版主了，这么晚了还让你费心，真心多谢！谢谢......！

无言感激！