Option Explicit

Sub 输出数据表(strSql As String, Work As String) '传值处理
'''''''''''''''''''''''''''''''''''''''''''
Dim data As New 数据库
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sht As Worksheet
Dim i As Integer
Dim Lm As Integer
Dim h As Integer
Set sht = ThisWorkbook.Worksheets(Work)
cn.Open data.SQL数据库
'循环查询到的列名，把列名的数量定义循环。
rs.Open strSql, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

i = 0
Lm = rs.Fields.Count '列名的数量定义
While i < Lm
    sht.Cells(2, i + 1) = rs.Fields(i).Name '列名读取
    i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行
Wend
rs.Close '关闭记录集
'''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''
'循环数据表
rs.Open strSql, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
i = 3
    Do While Not rs.EOF
        h = 1
        While h - 1 < Lm '当数据指针未移到记录集末尾时，循环下列操作
            sht.Cells(i, h) = rs(rs.Fields(h - 1).Name) '把当前字段2的值保存到sheet1工作表的第i行第2列
            h = h + 1
        Wend
        rs.MoveNext '把指针移向下一条记录
        i = i + 1
    Loop
rs.Close '关闭记录集

名称栏目：VBA_输出SQL查询数据
文章转载：http://hbruida.cn/article/iiicoj.html