知道SELECT语句怎么把查询到的数据输出到Excel中

来源:互联网 发布:java 通过ftp下载文件 编辑:程序博客网 时间:2024/05/18 03:12
Public Function getTblExcel(strExcel As String)    On Error GoTo Create    '-----------定义Excel的对象--------------    Dim xlApp As Excel.Application '引用了 Microsoft Excel 14.0就会出现这个对象    Dim xlWbk As Excel.Workbook    Dim xlWsh As Excel.Worksheet    Dim Rng As Excel.Range    Dim rsNum As Integer    '-----------定义DAO的对象用于创建DAO记录集--------------    Dim rst As New ADODB.Recordset    Dim i As Integer    '-------------打开记录集    Set rst = New ADODB.Recordset    rst.Open strExcel, CurrentProject.Connection, adOpenKeyset, adLockReadOnly    '------打开Excel表格-------    Set xlApp = GetObject(, "Excel.Application")    xlApp.Visible = True    Set xlWbk = xlApp.Workbooks.Add    Set xlWsh = xlWbk.Worksheets(1)    xlWsh.Activate    '------开始将记录集中的东西放到----------    Set Rng = xlWsh.Range("A1")    For i = 0 To rst.Fields.Count - 1            Rng.Value = rst.Fields(i).Name            Set Rng = Rng.Offset(0, 1)    Next i    Set Rng = xlWsh.Range("A2")    rst.MoveFirst    Do Until rst.EOF        For i = 0 To rst.Fields.Count - 1            Rng.Value = rst.Fields(i).Value            Set Rng = Rng.Offset(0, 1)        Next i        rst.MoveNext        Set Rng = Rng.Offset(1, -rst.Fields.Count)    Loop    '------关闭记录集----------    rst.Close    Set rst = Nothing    MsgBox "数据导出成功"    '------关闭Excel----------'    xlWbk.Close'    Set xlWsh = Nothing'    Set xlWbk = Nothing'    If xlApp.Workbooks.Count = 0 Then'        xlApp.Quit'    End IfCreate:    If Err = 429 Then        Set xlApp = CreateObject("Excel.Application")        Resume Next    End IfEnd Function
原创粉丝点击