VBA学习资料分享-4

工作中经常要从数据库把数据跑出来放到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