【access源码】一个用于将记录集数据导出到Excel的函数
时 间:2010-10-14 13:33:11
作 者:红尘如烟 ID:10768 城市:成都
摘 要:一个用于将记录集数据导出到Excel的函数
使用示例:
导出窗体数据: ExportToExcel Me.Recordset, "C:\Test.xls"
导出子窗体数据:ExportToExcel Me.子窗体.Form.Recordset, "C:\Test.xls"
导出列表框数据:ExPortToExcel Me.List1.Recordset, "C:\Test.xls"
正 文:
使用示例:
导出窗体数据: ExportToExcel Me.Recordset, "C:\Test.xls"
导出子窗体数据:ExportToExcel Me.子窗体.Form.Recordset, "C:\Test.xls"
导出列表框数据:ExPortToExcel Me.List1.Recordset, "C:\Test.xls"
'================================================================== '函数名称: ExportToExcel '功能描述: 将记录集中的数据导出到Excel文件 '输入参数: rst 必需的,用于导出数据的打开的记录集对象,可以使用窗体的Recordset属性 ' FileName 必需的,导出的Excel文件存放路径名 '返回参数: 成功导出返回True,否则返回False '使用说明: 可以对绑定窗体进行筛选,然后将窗体的Recrodset属性传递给rst参数,这样就可以将筛选结果导出,另 ' 外还可以用于导出列表框、组合框中的数据,同样只需要传递Recordset属性即可 '兼 容 性: 必须安装Excel,但无需引用 '作 者: 红尘如烟 '创建日期: 20010-10-14 '================================================================== Function ExportToExcel(rst As Object, FileName As String) As Boolean On Error GoTo Err_ExportToExcel Dim objExcelApp As Object Dim objExcelBook As Object Dim objExcelSheet As Object Dim objExcelQuery As Object If rst.RecordCount < 1 Then MsgBox ("没有数据可导出!"), vbExclamation GoSub Exit_ExportToExcel End If If Dir(FileName) <> "" Then Kill FileName DoCmd.Hourglass True Set objExcelApp = CreateObject("Excel.Application") Set objExcelBook = objExcelApp.Workbooks().Add() Set objExcelSheet = objExcelBook.Worksheets("sheet1") Set objExcelQuery = objExcelSheet.QueryTables.Add(rst, objExcelSheet.Range("A1")) With objExcelQuery .FieldNames = True .FillAdjacentFormulas = False .PreserveFormatting = True .BackgroundQuery = True .RefreshStyle = 1 ' xlInsertDeleteCells .SavePassword = True .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True End With objExcelQuery.Refresh objExcelBook.Worksheets("sheet1").SaveAs FileName ExportToExcel = True If MsgBox("数据已导出,是否打开并查看?", vbQuestion + vbYesNo) = vbYes Then objExcelApp.Visible = True Else objExcelBook.Saved = True objExcelApp.Quit End If Exit_ExportToExcel: Set objExcelApp = Nothing Set objExcelBook = Nothing Set objExcelSheet = Nothing Set rst = Nothing DoCmd.Hourglass False Exit Function Err_ExportToExcel: If Err = 70 Then MsgBox "无法删除文件 '" & FileName & "',可能该文件已被打开或没有权限。", vbCritical Else MsgBox Err.Source & " #" & Err & vbCrLf & vbCrLf & Err.Description, vbCritical End If Resume Exit_ExportToExcel End Function |
Access软件网QQ交流群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access高效办公】统计当...(06.30)
- 【Access高效办公】用复选...(06.24)
- 根据变化的日期来自动编号的示例...(06.20)
- 【Access高效办公】按日期...(06.12)
- 合并列数据到一个文本框的示例;...(05.06)
- 通过命令按钮让Access列表...(04.24)
- 【Access高效办公】统计当...(03.11)
- 【Access Inputbo...(03.03)
- 按回车键后光标移动到下一条记录...(02.12)

学习心得
最新文章
- Access快速开发平台--Err...(08.12)
- Deepseek资料整理神器(08.11)
- 【Access财务分析示例】按月统...(08.08)
- Access查询里使用Date()...(08.05)
- 关于Access交叉表查询生成的统...(08.02)
- ACCESS做的工作日常小工具_纸...(07.30)
- Access快速开发平台进销存教程...(07.28)
- 关于Access快速开发平台2.6...(07.23)
- 【Access交叉表查询】按百分比...(07.21)
- VBA编程-ADO-关于对象早晚期...(07.17)