|
本帖最后由 盗梦 于 2015-10-29 15:35 编辑
Access vba有各种方法可以导出到Excel,大致如下:
方法 | 优点 | 缺点 | 查询导出 | 可以根据查询设计(直观) | 格式固定 | ADO逐条遍历 | 写入位置可以灵活控制 | 速度较慢 | CopyFromRecordset | 速度极快 | 格式固定 | Excel插入QueryTable | 速度较快,可以汇总 | | 复制粘贴 | 标题、格式和子窗体一致 | 只能导出数据表显示的子窗体数据 |
1、利用查询导出
- DoCmd.OutputTo acOutputQuery, "具体的查询名称", acFormatXLS, , True
复制代码
执行这条语句,即可把对应的查询导出到Excel文件
拓展:
1)、当然,你也可以根据SQL语句自动创建查询,再导出。
CurrentDb.CreateQueryDef "新的查询名称", "SQL语句" '创建查询
2)、然后,导出之后,你可以删除掉这个查询
DoCmd.DeleteObject acQuery, "查询名称" '删除查询
3)、当然,你可以修改当前查询的SQL语句之后,再导出
Dim qdf As Object 'DAO.QueryDef
Set qdf = CurrentDb.QueryDefs("查询名称")
qdf.SQL = strSQL '设置新的SQL语句
2、ADO逐条遍历
这种方法是最传统和最典型的方法,也是最灵活的。
打开一个记录集,然后遍历数据对Excel操作即可。重点在操作Excel。
- Dim rs As New ADODB.Recordset
- Dim xlApp As Object 'Excel.Application
- Dim xlBook As Object 'Excel.Workbook
- Dim xlSheet As Object 'Excel.Worksheet
- Set xlApp = CreateObject("Excel.Application")
- Set xlBook = xlApp.Workbooks.Add '添加一个新的Book
- Set xlSheet = xlApp.ActiveSheet '使用当前的Sheet
- Dim strSql As String
- Dim i As Long
- strSql="Select * from 表1 where ID<10"
- rs.Open strSql, CurrentProject.Connection, 1, 1
- Do While Not rs.EOF
- xlSheet.Cells(2 + i,1)=rs("ID") '从第2行开始写数据
- xlSheet.Cells(2 + i,2)=rs("FName")
- rs.MoveNext
- i=i+1
- Loop
- rs.Close
- xlApp.Visible=True
复制代码
3、CopyFromRecordset导出数据
CopyFromRecordset是Excel vba的方法,可以快速把一个记录集的数据填充到Excel单元格中。
- '标题:根据SQL语句,快速导出到Excel文件
- '作者:阿航
- '创建日期:2015-01-10
- '说明:
- ' - 会将SQL语句的字段名作为标题。可以用As的方式设置对应字段的标题,如果是关键字,要加中括。
- ' - 示例:ExportToExcel "select FID as [ID], FText as 文本 from 表1"
- '更新日期:2015-09-05
- ' - 添加一个长度可变的参数,用于传递标题
- ' - 示例:ExportToExcel "select FID,FText from 表1","主键","文本"
- Public Function ExportToExcel(strSql As String, ParamArray VarExpr() As Variant) As Boolean
- Dim rs As Object 'DAO.Recordset(用ADO也行)
- Dim xlApp As Object 'Excel.Application
- Dim xlBook As Object 'Excel.Workbook
- Dim xlSheet As Object 'Excel.Worksheet
- Dim i As Integer
-
- '创建Excel文件
- On Error GoTo Err_Show
- Set xlApp = CreateObject("Excel.Application")
- Set xlBook = xlApp.Workbooks.Add '添加一个新的Book
- Set xlSheet = xlApp.ActiveSheet '使用当前的Sheet
-
- Set rs = CurrentDb.OpenRecordset(strSql)
- '先写入标题(可以考虑用DAO的字段标题属性 rs(i-1).Properties("Caption"))
- ' For i = 1 To rs.Fields.Count
- ' xlSheet.cells(1, i) = rs(i - 1).Name
- ' Next
- '更新部分(2015-09-05)长度可变的参数,相当于一个数组
- For i = 0 To UBound(VarExpr)
- xlSheet.cells(1, i + 1) = VarExpr(i)
- Next
-
- '再写入数据
- xlSheet.Range("A2").CopyFromRecordset rs
- rs.Close
-
- '调整列宽
- xlSheet.Columns.EntireColumn.AutoFit
- xlApp.Visible = True
- xlBook.Activate
- ExportToExcel = True
-
- Err_Exit:
- Set xlSheet = Nothing
- Set xlBook = Nothing
- Set xlApp = Nothing
- Set rs = Nothing
- Exit Function
- Err_Show:
- MsgBox "导出出错,请重新尝试" & vbCrLf & Err.Description, "导出出错"
- On Error Resume Next
- '出错则清掉文件,避免有多个Excel进程
- xlBook.Close False
- If xlApp.Workbooks.Count = 0 Then xlApp.Quit
- GoTo Err_Exit
- End Function
复制代码
4、Excel插入QueryTable
QueryTable是Excel的一种表格对象,可以插入一个DAO记录集
- '---用记录填充Excel表格
- '输入参数: RS,需要填充的记录集
- ' InsertSheet, 需要填充的Excel工作表
- ' InsertSheet, 需要开始填充的单元格
- '返回参数, 填充完毕的range
- Public Function FillRS(ByRef rsInsert As DAO.Recordset, ByRef sheetInsert As Excel.Worksheet, rangeInsert As Excel.Range) As Excel.Range
- Dim qtTable As Excel.QueryTable
- Dim loListObject As Excel.ListObject
- '根据记录集生成一个querytable
- rsInsert.MoveFirst
- Set qtTable = sheetInsert.QueryTables.Add(Connection:=rsInsert, Destination:=rangeInsert)
- With qtTable
- .FieldNames = True
- .AdjustColumnWidth = True
- .Refresh BackgroundQuery:=False
- End With
- ' 把QueryTable ListObject
- Set loListObject = sheetInsert.ListObjects.Add(xlSrcRange, qtTable.ResultRange, , xlYes)
- With loListObject
- .ShowTotals = True '显示汇总列
- .ShowAutoFilter = True
- '显示汇总数据
- Dim fld As DAO.Field
- For Each fld In rsInsert.Fields
- Select Case fld.Type
- Case dbCurrency
- '.ListColumns(fld.Name).TotalsCalculation = xlTotalsCalculationSum
- .ListColumns(fld.Name).Range.NumberFormat = "#,##0.00;-#,##0.00"
- Case dbDate
- .ListColumns(fld.Name).Range.NumberFormat = "yyyy-mm-dd;@"
- End Select
- Next
- '.TableStyle = "TableStyleMedium9"
- '.Range.AutoFormat xlRangeAutoFormatList1
- Set FillRS = .Range
- .Unlink
- .Unlist
- End With
- Set qtTable = Nothing
- End Function
复制代码
5、复制粘贴的方法,快速导出数据
在某次发现了,可以手动复制子窗体上的数据,然后粘贴到Excel中。于是就尝试用这代码实现这个功能
- Me.子窗体控件名.SetFocus '子窗体控件获得焦点
- DoCmd.RunCommand acCmdSelectAllRecords '选中所有记录
- DoCmd.RunCommand acCmdCopy '复制
- DoEvents
- Dim Obj As Object
- Set Obj = CreateObject("excel.application") '创建Excel对象
- Obj.workbooks.Add '新建工作簿
- Obj.Visible = True '设为可见
- SendKeys "^v", True '粘贴数据
复制代码
当然,还有其他各种方法,例如利用OpenXML方法导出。大家可以回复讨论交流一下。
|
评分
-
参与人数 1 | 经验 +10 |
金钱 +10 |
技术 +1 |
V币 +1 |
收起
理由
|
5988143
| + 10 |
+ 10 |
+ 1 |
+ 1 |
(其它)优秀教程、原创内容、以资鼓励、其. |
查看全部评分
|