設(shè)為首頁收藏本站Access中國

Office中國論壇/Access中國論壇

 找回密碼
 注冊

QQ登錄

只需一步，快速開始

返回列表 發(fā)新帖
查看: 5993|回復(fù): 2
打印 上一主題 下一主題

[模塊/函數(shù)] 【總結(jié)】Access導(dǎo)出到Excel方法匯總

[復(fù)制鏈接]

點擊這里給我發(fā)消息
跳轉(zhuǎn)到指定樓層
1#
發(fā)表于 2015-10-29 13:47:34 | 只看該作者 回帖獎勵 |倒序瀏覽 |閱讀模式
本帖最后由 盜夢 于 2015-10-29 15:35 編輯

Access vba有各種方法可以導(dǎo)出到Excel，大致如下：

方法 優(yōu)點缺點
查詢導(dǎo)出 可以根據(jù)查詢設(shè)計(直觀) 格式固定
ADO逐條遍歷 寫入位置可以靈活控制 速度較慢
CopyFromRecordset 速度極快   格式固定
Excel插入QueryTable 速度較快，可以匯總
復(fù)制粘貼 標(biāo)題、格式和子窗體一致 只能導(dǎo)出數(shù)據(jù)表顯示的子窗體數(shù)據(jù)

1、利用查詢導(dǎo)出
  1. DoCmd.OutputTo acOutputQuery, "具體的查詢名稱", acFormatXLS, , True
復(fù)制代碼

執(zhí)行這條語句，即可把對應(yīng)的查詢導(dǎo)出到Excel文件

拓展：
1）、當(dāng)然，你也可以根據(jù)SQL語句自動創(chuàng)建查詢，再導(dǎo)出。
    CurrentDb.CreateQueryDef "新的查詢名稱", "SQL語句"  '創(chuàng)建查詢
2）、然后，導(dǎo)出之后，你可以刪除掉這個查詢
    DoCmd.DeleteObject acQuery, "查詢名稱"              '刪除查詢
3）、當(dāng)然，你可以修改當(dāng)前查詢的SQL語句之后，再導(dǎo)出
    Dim qdf As Object  'DAO.QueryDef
    Set qdf = CurrentDb.QueryDefs("查詢名稱")
    qdf.SQL = strSQL   '設(shè)置新的SQL語句

2、ADO逐條遍歷
這種方法是最傳統(tǒng)和最典型的方法，也是最靈活的。
打開一個記錄集，然后遍歷數(shù)據(jù)對Excel操作即可。重點在操作Excel。
  1.     Dim rs As New ADODB.Recordset
  2.     Dim xlApp As Object     'Excel.Application
  3.     Dim xlBook As Object    'Excel.Workbook
  4.     Dim xlSheet As Object   'Excel.Worksheet

  6.     Set xlApp = CreateObject("Excel.Application")
  7.     Set xlBook = xlApp.Workbooks.Add    '添加一個新的Book
  8.     Set xlSheet = xlApp.ActiveSheet     '使用當(dāng)前的Sheet

  10.     Dim strSql As String
  11.     Dim i As Long

  13.     strSql="Select * from 表1 where ID<10"
  14.     rs.Open strSql, CurrentProject.Connection, 1, 1
  15.         Do While Not rs.EOF
  16.             xlSheet.Cells(2 + i,1)=rs("ID")   '從第2行開始寫數(shù)據(jù)
  17.             xlSheet.Cells(2 + i,2)=rs("FName")
  18.             rs.MoveNext
  19.             i=i+1
  20.         Loop
  21.     rs.Close

  23.     xlApp.Visible=True
復(fù)制代碼


3、CopyFromRecordset導(dǎo)出數(shù)據(jù)
CopyFromRecordset是Excel vba的方法，可以快速把一個記錄集的數(shù)據(jù)填充到Excel單元格中。
  1. '標(biāo)題：根據(jù)SQL語句，快速導(dǎo)出到Excel文件
  2. '作者：阿航

  4. '創(chuàng)建日期：2015-01-10
  5. '說明：
  6. '   - 會將SQL語句的字段名作為標(biāo)題�？梢杂肁s的方式設(shè)置對應(yīng)字段的標(biāo)題，如果是關(guān)鍵字，要加中括。
  7. '   - 示例：ExportToExcel "select FID as [ID], FText as 文本 from 表1"

  9. '更新日期：2015-09-05
  10. '   - 添加一個長度可變的參數(shù)，用于傳遞標(biāo)題
  11. '   - 示例：ExportToExcel "select FID,FText from 表1","主鍵","文本"
  12. Public Function ExportToExcel(strSql As String, ParamArray VarExpr() As Variant) As Boolean
  13.     Dim rs As Object        'DAO.Recordset（用ADO也行）
  14.     Dim xlApp As Object     'Excel.Application
  15.     Dim xlBook As Object    'Excel.Workbook
  16.     Dim xlSheet As Object   'Excel.Worksheet
  17.     Dim i As Integer
  18.          
  19.     '創(chuàng)建Excel文件
  20. On Error GoTo Err_Show
  21.     Set xlApp = CreateObject("Excel.Application")
  22.     Set xlBook = xlApp.Workbooks.Add    '添加一個新的Book
  23.     Set xlSheet = xlApp.ActiveSheet     '使用當(dāng)前的Sheet
  24.          
  25.     Set rs = CurrentDb.OpenRecordset(strSql)
  26.     '先寫入標(biāo)題(可以考慮用DAO的字段標(biāo)題屬性 rs(i-1).Properties("Caption"))
  27. '    For i = 1 To rs.Fields.Count
  28. '        xlSheet.cells(1, i) = rs(i - 1).Name
  29. '    Next
  30.     '更新部分（2015-09-05）長度可變的參數(shù)，相當(dāng)于一個數(shù)組
  31.     For i = 0 To UBound(VarExpr)
  32.         xlSheet.cells(1, i + 1) = VarExpr(i)
  33.     Next
  34.               
  35.     '再寫入數(shù)據(jù)
  36.     xlSheet.Range("A2").CopyFromRecordset rs
  37.     rs.Close
  38.          
  39.     '調(diào)整列寬
  40.     xlSheet.Columns.EntireColumn.AutoFit
  41.     xlApp.Visible = True
  42.     xlBook.Activate
  43.     ExportToExcel = True
  44.          
  45. Err_Exit:
  46.     Set xlSheet = Nothing
  47.     Set xlBook = Nothing
  48.     Set xlApp = Nothing
  49.     Set rs = Nothing
  50.     Exit Function
  51. Err_Show:
  52.     MsgBox "導(dǎo)出出錯，請重新嘗試" & vbCrLf & Err.Description, "導(dǎo)出出錯"
  53.     On Error Resume Next
  54.     '出錯則清掉文件，避免有多個Excel進程
  55.     xlBook.Close False
  56.     If xlApp.Workbooks.Count = 0 Then xlApp.Quit
  57.     GoTo Err_Exit
  58. End Function
復(fù)制代碼


4、Excel插入QueryTable
QueryTable是Excel的一種表格對象，可以插入一個DAO記錄集
  1. '---用記錄填充Excel表格
  2. '輸入?yún)?shù): RS,需要填充的記錄集
  3. '          InsertSheet, 需要填充的Excel工作表
  4. '          InsertSheet, 需要開始填充的單元格
  5. '返回參數(shù), 填充完畢的range

  7. Public Function FillRS(ByRef rsInsert As DAO.Recordset, ByRef sheetInsert As Excel.Worksheet, rangeInsert As Excel.Range) As Excel.Range
  8.     Dim qtTable As Excel.QueryTable
  9.     Dim loListObject As Excel.ListObject

  11.     '根據(jù)記錄集生成一個querytable
  12.     rsInsert.MoveFirst

  14.     Set qtTable = sheetInsert.QueryTables.Add(Connection:=rsInsert, Destination:=rangeInsert)

  16.     With qtTable
  17.         .FieldNames = True
  18.         .AdjustColumnWidth = True
  19.         .Refresh BackgroundQuery:=False
  20.     End With


  23.     ' 把QueryTable ListObject
  24.     Set loListObject = sheetInsert.ListObjects.Add(xlSrcRange, qtTable.ResultRange, , xlYes)

  26.     With loListObject
  27.         .ShowTotals = True   '顯示匯總列
  28.         .ShowAutoFilter = True

  30.         '顯示匯總數(shù)據(jù)
  31.         Dim fld As DAO.Field
  32.         For Each fld In rsInsert.Fields
  33.             Select Case fld.Type
  34.                 Case dbCurrency
  35.                     '.ListColumns(fld.Name).TotalsCalculation = xlTotalsCalculationSum
  36.                     .ListColumns(fld.Name).Range.NumberFormat = "#,##0.00;-#,##0.00"

  38.                 Case dbDate
  39.                     .ListColumns(fld.Name).Range.NumberFormat = "yyyy-mm-dd;@"
  40.             End Select
  41.         Next
  42.         '.TableStyle = "TableStyleMedium9"

  44.         '.Range.AutoFormat xlRangeAutoFormatList1
  45.         Set FillRS = .Range
  46.         .Unlink
  47.         .Unlist
  48.     End With

  50.     Set qtTable = Nothing
  51. End Function
復(fù)制代碼


5、復(fù)制粘貼的方法，快速導(dǎo)出數(shù)據(jù)
在某次發(fā)現(xiàn)了，可以手動復(fù)制子窗體上的數(shù)據(jù)，然后粘貼到Excel中。于是就嘗試用這代碼實現(xiàn)這個功能
  1.     Me.子窗體控件名.SetFocus                    '子窗體控件獲得焦點
  2.     DoCmd.RunCommand acCmdSelectAllRecords      '選中所有記錄
  3.     DoCmd.RunCommand acCmdCopy                  '復(fù)制
  4.     DoEvents

  6.     Dim Obj As Object
  7.     Set Obj = CreateObject("excel.application") '創(chuàng)建Excel對象
  8.     Obj.workbooks.Add                           '新建工作簿
  9.     Obj.Visible = True                          '設(shè)為可見
  10.     SendKeys "^v", True                         '粘貼數(shù)據(jù)
復(fù)制代碼


當(dāng)然，還有其他各種方法，例如利用OpenXML方法導(dǎo)出。大家可以回復(fù)討論交流一下。

評分

參與人數(shù) 1經(jīng)驗 +10 金錢 +10 技術(shù) +1 V幣 +1 收起 理由
5988143 + 10 + 10 + 1 + 1 （其它）優(yōu)秀教程、原創(chuàng)內(nèi)容、以資鼓勵、其.

查看全部評分

分享到:  QQ好友和群QQ好友和群 QQ空間QQ空間 騰訊微博騰訊微博 騰訊朋友騰訊朋友
收藏收藏2 分享分享 分享淘帖 訂閱訂閱
2#
發(fā)表于 2015-10-29 14:58:16 | 只看該作者
好貼.
回復(fù)

使用道具 舉報

3#
發(fā)表于 2015-10-30 07:39:55 | 只看該作者
總結(jié)不錯！謝謝分享
您需要登錄后才可以回帖 登錄 | 注冊

本版積分規(guī)則

QQ|站長郵箱|小黑屋|手機版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 08:22 , Processed in 0.220171 second(s), 30 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回復(fù) 返回頂部 返回列表