Excel VBA_ADO+SQL实例集锦

2019-04-08 20:25

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 = \

Myr = [a65536].End(xlUp).Row + 1 If Myr < 4 Then Myr = 4

Cells(Myr, 3).CopyFromRecordset Conn.Execute(Sql) Cells(Myr, 1) = Myr - 3

Cells(Myr, 2) = Left(mvvar(i), Len(mvvar(i)) - 4) Sql = \

Cells(Myr, 4).CopyFromRecordset Conn.Execute(Sql) Sql = \

Cells(Myr, 5).CopyFromRecordset Conn.Execute(Sql) Sql = \

Cells(Myr, 6).CopyFromRecordset Conn.Execute(Sql) Conn.Close End If Next Else

MsgBox \没有找到文件。\End If

Myr = Myr + 1

Cells(Myr, 2) = \合计\

Cells(Myr, 3).Formula = \

Cells(Myr, 3).AutoFill Cells(Myr, 3).Resize(1, 5) End Sub

Function FileList(fldr, Optional fltr As String = \ Dim sTemp As String, sHldr As String

If Right$(fldr, 1) <> \ sTemp = Dir(fldr & fltr) If sTemp = \ FileList = False Exit Function End If Do

sHldr = Dir

If sHldr = \ sTemp = sTemp & \ Loop

FileList = Split(sTemp, \End Function

'引用一个单元格,如 k1 单元格 Sub onecell() Dim Sql$

Set Conn = CreateObject(\


Excel VBA_ADO+SQL实例集锦.doc 将本文的Word文档下载到电脑 下载失败或者文档不完整,请联系客服人员解决!

下一篇:2013-2018年中国激光医疗器械市场预测与投资咨询分析报告

相关阅读
本类排行
× 注册会员免费下载(下载后可以自由复制和排版)

马上注册会员

注:下载文档有可能“只有目录或者内容不全”等情况,请下载之前注意辨别,如果您已付费且无法下载或内容有问题,请联系我们协助你处理。
微信: QQ: