初学ADO献上小作《电话簿管理系统》

feiren228

zhaogang1960 发表于 2015-1-22 00:26

谢谢赵老师深夜还在指导，这个是新建工作表吧？提示sheet1已存在

zhaogang1960

feiren228 发表于 2015-1-22 00:32
谢谢赵老师深夜还在指导，这个是新建工作表吧？提示sheet1已存在

这种使用方法应该是：
一、如果文件不存在，则创建一个文件的同时，也创建了工作表
二、如果文件存在，则只能创建一个文件中不存在的工作表

通常是用Dir函数测试一下文件是否存在，如果存在则删除它

feiren228

zhaogang1960 发表于 2015-1-22 00:40
这种使用方法应该是：
一、如果文件不存在，则创建一个文件的同时，也创建了工作表
二、如果文件存在， ...

谢谢赵老师，能用insert吗？
早点休息

zhaogang1960

feiren228 发表于 2015-1-22 00:42
谢谢赵老师，能用insert吗？
早点休息

如果没有目标表.xls工作簿，或没有Sheet1工作表，则创建工作表，否则用insert插入新纪录：

1. Sub Macro1()
   
2.     '需引用Microsoft ActiveX Data Objects 2.0 Library以上
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim SQL$, dataname$
   
5.     dataname = ThisWorkbook.Path & "\目标表.xls"
   
6.     If Application.Version * 1 <= 11 Then
   
7.         cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes';data source=" & dataname
   
8.     Else
   
9.         cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes';data source=" & dataname
   
10.     End If
    
11.     SQL = "select * into sheet1 from [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[Sheet1$]" '如果没有目标表.xls工作簿，或没有Sheet1工作表
    
12.     If Dir(dataname) <> "" Then
    
13.         If Not cnn.OpenSchema(20, Array(Empty, Empty, "sheet1$", Empty)).EOF Then _
    
14.             SQL = "insert into [Sheet1$] select * from [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[Sheet1$]" '如果Sheet1工作表已经存在，则将数据插入到该表的下面
    
15.     End If
    
16.     cnn.Execute SQL
    
17.     cnn.Close
    
18.     Set cnn = Nothing
    
19. End Sub

复制代码

zhaogang1960

请参考附件
工作簿或工作表不存在则生成工作表否则就向该表插入数据.rar (10.47 KB, 下载次数: 82)

2015-1-22 13:12 上传

点击文件名下载附件

ppl123

版主你好，能帮我在电话簿管理系统(以access为数据库) 添加一个一键导入excel数据的功能吗，因为我的数据量有好几百条，现在手动输入太麻烦了，另外，不小心点了某条数据，右边输入框就会有对应的数据显示，要想再添加就得手动清除右边的数据也麻烦，能不能实现点添加右边的数据就自动清除，可方便添加呢？谢谢!

zhaogang1960

ppl123 发表于 2015-1-31 12:46
版主你好，能帮我在电话簿管理系统(以access为数据库) 添加一个一键导入excel数据的功能吗，因为我的数据量 ...

在工作簿中插入一张新表——数据库，更新Access中已经存在的记录，添加不存在的记录：

1. Sub updateaddRecords()
   
2.     Dim cnn As New ADODB.Connection
   
3.     Dim rs As New ADODB.Recordset
   
4.     Dim myTable As String
   
5.     Dim strTemp As String
   
6.     Dim SQL As String
   
7.     Dim strMsg As String
   
8.     Dim aField As Variant
   
9.     Dim i As Long
   
10.     myTable = "数据库"
    
11.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\电话号码.mdb"
    
12.     SQL = "SELECT B.姓名 FROM " & myTable & " A,[Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" _
    
13.         & Range("A1").CurrentRegion.Address(0, 0) & "] B WHERE A.姓名=B.姓名"
    
14.     Set rs = New ADODB.Recordset
    
15.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
16.     If rs.RecordCount > 0 Then
    
17.         aField = Intersect(Range("A1").CurrentRegion, Rows(1))
    
18.         For i = 2 To UBound(aField, 2)
    
19.             strTemp = strTemp & ",a." & aField(1, i) & "=b." & aField(1, i)
    
20.         Next
    
21.         SQL = "UPDATE " & myTable & " A,[Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" _
    
22.             & Range("A1").CurrentRegion.Address(0, 0) & "] B SET " & Mid(strTemp, 2) & " WHERE A.姓名=B.姓名"
    
23.         cnn.Execute SQL
    
24.         strMsg = rs.RecordCount & "条记录已更新！"
    
25.     End If
    
26.     If Range("A1").CurrentRegion.Rows.Count - 1 > rs.RecordCount Then
    
27.         SQL = " SELECT A.* FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" & 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.         If rs.RecordCount > 0 Then
    
32.             SQL = "INSERT INTO " & myTable & SQL
    
33.             cnn.Execute SQL
    
34.             strMsg = strMsg & vbCrLf & rs.RecordCount & "条记录已添加到数据库！"
    
35.         End If
    
36.     End If
    
37.     MsgBox strMsg, vbInformation, "提示"
    
38.     rs.Close
    
39.     cnn.Close
    
40.     Set rs = Nothing
    
41.     Set cnn = Nothing
    
42. End Sub
    

复制代码

zhaogang1960

请看附件
电话簿管理系统(以access为数据库)新增导入excel数据功能.rar (43.71 KB, 下载次数: 103)

2015-1-31 13:30 上传

点击文件名下载附件

update365

版主，提个小小意见，
如图

feiren228

zhaogang1960 发表于 2015-1-22 13:11
如果没有目标表.xls工作簿，或没有Sheet1工作表，则创建工作表，否则用insert插入新纪录：

请教赵老师，关于excel数据写入SQL数据库的问题
http://club.excelhome.net/forum. ... =1200625&extra=