工作中经常要从数据库把数据跑出来放到EXCEL上,才能进行下一步的操作,那么VBA如何结合SQL提取数据呢?答案就是ADO。
声明和实例变量
引用法——引用Microsoft ActiveX Data Objects x.x Library,Microsoft ActiveX Data Objects Recordset x.x Library,声明的同时使用New实现了初始实例化
Dim conn as New Connection Dim rre as New Recordset
创建法——使用createobject函数创建
Dim conn as object Dim rre as object Set conn=CreateObject("adodb.connection") Set rre=CreateObject("adodb.recordset")
设置连接属性
conn.ConnectionTimeout = 10000 '指示在终止尝试和产生错误前建立连接期间所等待的时间。 conn.CommandTimeout = 10000 '指示在终止尝试和产生错误之前执行命令期间需等待的时间。 connstr = "Provider = SQLOLEDB;Server = XXXXX;Trusted_Connection=yes" '无需密码时的连接 connstr = "Provider = SQLOLEDB;Data Source = XXXXX;Initial Catalog = XXXXX;User ID =XXXXX;Password = XXXXX;" '需要密码时的连接 conn.ConnectionString = connstr
执行SQL语句
conn.Open Sql = "select * from ......" Set rre = conn.Execute(Sql) 'rre.Open Sql, conn, adOpenKeyset, adLockOptimistic '另一种用法 '多条SQL语句可以分句执行 Sql0="Use DataBase" Sql1="IF object_id('tempdb.dbo.#t1') is not null drop table #t1" Sql2="alter table #t1 add ......" Sql3="update #t1 set ......" Sql4="select * from ......" Set rre = conn.Execute(Sql0) Set rre = conn.Execute(Sql1) Set rre = conn.Execute(Sql2) Set rre = conn.Execute(Sql3) Set rre = conn.Execute(Sql4)
读写查询结果
if rre.RecordCount=0 then '判断结果是否为空 Msgbox "没有查到任何数据" exit sub end if For i = 0 To rre.Fields.Count - 1 '循环读写字段名 ThisWorkbook.Sheets(1).Cells(1,i+1) = rre.Fields(i).Name Next ThisWorkbook.Sheets(1).Range("A2").CopyFromRecordset rre '批量读写结果 r=2 While Not rre.EOF '循环读写结果 For i = 0 To rre.Fields.Count - 1 Sheet1.Cells(r, i + 1) = rre.Fields(i).Value Next i r = r + 1 rre.MoveNext Wend
关闭缓存和释放内存
rre.Close conn.Close set rre=Nothing set conn=Nothing
如果是调用存储过程而不是直接执行SQL语句的,可以这么写:
Dim conn As New ADODB.Connection Dim cmd As New ADODB.Command Dim rst As New ADODB.Recordset conn.Open "Provider=SQLOLEDB;Data Source=XXXXX;Initial Catalog=XXXXX;User Id=XXXXX;Password=XXXXX" cmd.CommandType = adCmdStoredProc cmd.CommandText = "dbo.XXXXX" cmd.CommandTimeout = 10000 cmd.ActiveConnection = conn rst.Open cmd, , adOpenForwardOnly, adLockReadOnly ThisWorkbook.Sheets(1).Range("a2").CopyFromRecordset rst rst.Close conn.Close Set rst = Nothing Set conn = Nothing
Set cmd = Nothing