|
Access vba有各种方法可以导出到Excel，大致如下表 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 '粘贴数据 Access推荐资源 Access开发心得 Access培训讲师
张志，2003年-2013连续10年获选微软最有价值专家，Access数据库培训讲师，十余年Access数据库培训经验，服务过的知名企业有北京奔驰、立达（中国）纺织仪器有限公司、中信泰富特钢集团等。 Access软件公司 上海盟威软件有限公司(www.UMVsoft.com)，专注于Access培训及为客户用Access定制开发软件。由微软最有价值专家团队创建，设有江阴分公司、株洲分公司。公司自主研发了国内第一款Access开发平台(盟威软件快速开发平台)，利用此平台，零基础的人士可以开发出专业的管理类软件，让管理人才转型为“精管理 会编程”的复合型人才。 |
|
|
