工作中经常要从数据库把数据跑出来放到EXCEL上，才能进行下一步的操作，那么VBA如何结合SQL提取数据呢？答案就是ADO。

声明和实例变量

引用法——引用Microsoft ActiveX Data Objects x.x Library，Microsoft ActiveX Data Objects Recordset x.x Library，声明的同时使用New实现了初始实例化

Dim conn as New ConnectionDim rre as New Recordset

创建法——使用createobject函数创建

Dim conn as objectDim rre as objectSet 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.OpenSql = "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 subend ifFor i = 0 To rre.Fields.Count - 1    '循环读写字段名ThisWorkbook.Sheets(1).Cells(1,i+1) = rre.Fields(i).NameNextThisWorkbook.Sheets(1).Range("A2").CopyFromRecordset rre    '批量读写结果r=2While 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.MoveNextWend

关闭缓存和释放内存

rre.Closeconn.Closeset rre=Nothingset conn=Nothing

 如果是调用存储过程而不是直接执行SQL语句的，可以这么写：

Dim conn As New ADODB.ConnectionDim cmd As New ADODB.CommandDim rst As New ADODB.Recordsetconn.Open "Provider=SQLOLEDB;Data Source=XXXXX;Initial Catalog=XXXXX;User Id=XXXXX;Password=XXXXX"cmd.CommandType = adCmdStoredProccmd.CommandText = "dbo.XXXXX"cmd.CommandTimeout = 10000cmd.ActiveConnection = connrst.Open cmd, , adOpenForwardOnly, adLockReadOnlyThisWorkbook.Sheets(1).Range("a2").CopyFromRecordset rstrst.Closeconn.CloseSet rst = NothingSet conn = Nothing Set cmd = Nothing