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

xiaoxiao2021-02-28  104

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 If Create: If Err = 429 Then Set xlApp = CreateObject("Excel.Application") Resume Next End If End Function
转载请注明原文地址: https://www.6miu.com/read-27737.html

最新回复(0)