sql中创建表录入数据

840966810

能否用VBA语句用sql连接到一个EXCEL表在这个表中创建一个sheet，然后在这个sheet中录入另一个EXCEL表的第一列的数据？ 求大神指导

lzqmsy

描述的不是很清楚

zhaogang1960

请参考:

1. Sub Macro1()
   
2. '引用Microsoft AD0 Ext 2.8 for DDL and Security
   
3. '引用Microsoft ActiveX Data Objects 2.x Library
   
4.     Dim cnn As New ADODB.Connection
   
5.     Dim Cat  As New ADOX.Catalog, tb1 As Table
   
6.     Dim ok As Boolean
   
7.     Dim sh As String
   
8.     Dim s$, SQL$
   
9.     sh = "新建工作表"
   
10.     Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & ThisWorkbook.Path & "\目标工作簿.xls"
    
11.     For Each tb1 In Cat.Tables
    
12.         If tb1.Type = "TABLE" Then
    
13.             s = Replace(tb1.Name, "'", "") '表名含有数字时有多余的单引号
    
14.             If Right(s, 1) = "$" Then
    
15.                 If s = sh & "$" Then
    
16.                     ok = True
    
17.                     Exit For
    
18.                 End If
    
19.             End If
    
20.         End If
    
21.     Next
    
22.     Set Cat = Nothing
    
23.     Set tb1 = Nothing
    
24.     If ok Then
    
25.         MsgBox "不能创建工作表，目标工作簿中已经存在工作表" & sh, vbInformation
    
26.         Exit Sub
    
27.     End If
    
28.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\目标工作簿.xls" '连接数据库
    
29.     SQL = "select 字段1 into [" & sh & "] from [Excel 8.0;Database=" & ThisWorkbook.Path & "\数据源.xls].[Sheet1$]"
    
30.     cnn.Execute SQL
    
31.     cnn.Close
    
32.     Set cnn = Nothing
    
33.     MsgBox "ok"
    
34. End Sub
    

复制代码

zhaogang1960

请测试附件:
sql中创建表录入数据.rar (16.88 KB, 下载次数: 194)

2013-5-10 23:09 上传

点击文件名下载附件

840966810

zhaogang1960 发表于 2013-5-10 23:09
请测试附件:

多谢刚神的帮助，顶顶顶！！

dickywjl

完全是在出考题，Excel表格创建非要用SQL去创建，需要多费多少语句。

zhaogang1960

dickywjl 发表于 2013-5-11 14:58
完全是在出考题，Excel表格创建非要用SQL去创建，需要多费多少语句。

不太费语句，我是为了更清晰的说明问题才用了ADOX来查看是否已经存在要插入的工作表，可以加上错误处理语句，直接插入工作表，如果出错就说明已经存在要插入的工作表

zhaogang1960

简易代码如下：

1. Sub sql中创建表录入数据()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim sh As String
   
5.     Dim s$, SQL$
   
6.     sh = "新建工作表"
   
7.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\目标工作簿.xls" '连接数据库
   
8.     SQL = "select 字段1 into [" & sh & "] from [Excel 8.0;Database=" & ThisWorkbook.Path & "\数据源.xls].[Sheet1$]"
   
9.     On Error Resume Next
   
10.     cnn.Execute SQL
    
11.     cnn.Close
    
12.     Set cnn = Nothing
    
13.     If Err.Number <> 0 Then
    
14.         MsgBox "不能创建工作表，目标工作簿中已经存在工作表" & sh, vbInformation
    
15.     Else
    
16.         MsgBox "ok"
    
17.     End If
    
18. End Sub
    

复制代码