Excel VBA_ADO+SQL实例集锦

1, 包含空值的记录 f13 is null

‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=46032&page=1 ‘订单生成系统.xls ‘f6-第6列，f2-第2列

Private Sub Worksheet_Activate() On Error Resume Next

Dim x As Object, yy As Object, sql As String Set x = CreateObject(\

x.Open \Properties='Excel 8.0;hdr=no;';Data Source=\

sql = \f13 is null)\ ‘不等于字符串用 ‘C3’ 包含空值用 is null Set yy = x.Execute(sql) Range(\

Range(\编号\品名\规格\产地\单位\件装\属性\计划\ ‘表头 另外赋值

[a2].CopyFromRecordset yy Set yy = Nothing Set x = Nothing End Sub

2，用ADO Connection对象查询

Option Explicit

Public conn As ADODB.Connection Sub Myquery()

Dim sConnect$, sql1$

Set conn = CreateObject(\Sheets(\

sConnect = \ \

sql1 = \物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' \ '表格名要用[$],条件部分用单引号''

ThisWorkbook.Sheets(\1).CopyFromRecordset conn.Execute(sql1) 'copy后面紧接SQL查询执行语句

With Sheets(\

.Range(\物料代码\ '建立表头 .Range(\物料描述\ .Range(\属性\ .Range(\单位\ End With

'conn.Close '可不用每次关闭数据源的连接 End Sub

3，用记录集执行单个查询

Option Explicit Sub Myquery()

Dim rd As ADODB.Recordset

Dim i%, j%, k%, sConnect$, sql1$, str$ Set rd = New ADODB.Recordset str = \外协\

Sheets(\

sConnect = \ \ 'conn.Open sConnect '打开数据源

sql1 = \物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' \ '表格名要用[$],条件部分用单引号''

rd.Open sql1, sConnect, adOpenForwardOnly, adLockReadOnly ThisWorkbook.Sheets(\ With Sheets(\

.Range(\物料代码\ '建立表头 .Range(\物料描述\ .Range(\属性\ .Range(\单位\ End With

rd.Close '关闭记录集 Set rd=Nothing '关闭 End Sub

4，引用一列，如A列

‘引用单列、单行、单个单元格.xls '引用一列，如A列 Sub onecolumn() Dim Sql$

Set Conn = CreateObject(\

Conn.Open \properties='excel 8.0;hdr=no';data source=\

Sql = \ Cells.Clear

[a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close

Set Conn = Nothing

End Sub

Sub dgzbhz() '2008/12/2

‘http://www.exceljy.com/viewthread.php?tid=4912&pid=82252&page=1&extra=page=1#pid82252

‘Book12021.xls

‘由于分表的第2列表头是“金额”，不用它，改为“一中”，所以要用hdr=no无标题，拷贝时把第一行表头归零，所以最后要加表头。

Dim Sql$

Set Conn = CreateObject(\ [b2:d4] = \

arr = Array(\一中\二中\三中\ For i = 0 To UBound(arr) Conn.Open \properties='excel 8.0;hdr=no';data source=\

Sql = \

Cells(1, i + 2).CopyFromRecordset Conn.Execute(Sql) Conn.Close Next i

Set Conn = Nothing [b1:d1] = arr End Sub

‘test1203.xls EH

‘有标题不用hdr=no，列名用编码文字，可往下连续取数据。 Private Function cnn() As Object

Set cnn = CreateObject(\ cnn.Open \Properties ='Excel 8.0;HDR=no';Data Source= \

End Function

Sub onecolumn()

Dim Sql$, Sht1 As Worksheet, Sht As Worksheet Dim n

Set Sht1 = Sheets(\汇总\ Sht1.Activate

‘Set Conn = CreateObject(\

‘Conn.Open \& ThisWorkbook.FullName

For Each Sht In Sheets

If Sht.Name <> \汇总\

Sql = \编码 from [\ n = [b65536].End(xlUp).Row + 1

Sht1.Cells(n, 2).CopyFromRecordset Cnn.Execute(Sql) End If Next Sht Cnn.Close

Set Cnn = Nothing End Sub

5，引用一行,如第1行

'引用一

Sub onerow() Dim Sql$

Set Conn = CreateObject(\

Conn.Open \properties='excel 8.0;hdr=no';data source=\

Sql = \ Cells.Clear

[a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close

Set Conn = Nothing End Sub

6，引用一个单元格，如 k1 单元格

‘2013-3-14

‘http://club.excelhome.net/thread-992260-1-1.html Dim Sql$, Conn

Sub testit()

Dim myPath$, mvvar, i&, myName$, Myr& Sheet1.Activate

[a4:h500].ClearContents

Set Conn = CreateObject(\myPath = ThisWorkbook.Path & \myName = ThisWorkbook.Name mvvar = FileList(myPath)

If TypeName(mvvar) <> \

For i = LBound(mvvar) To UBound(mvvar) If mvvar(i) <> myName Then

Conn.Open \Properties='Excel 12.0;hdr=no';data source=\

Sql = \