Excel导出与导入_TestForm专题实例

将记录集数据导出到Excel的函数

使用示例:
导出窗体数据: 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,但无需引用
&#;作 者: 红尘如烟
&#;创建日期:
&#;================================
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 = Then
MsgBox &#;无法删除文件 &#;&#; & FileName & &#;&#;,可能该文件已被打开或没有权限。&#;, vbCritical
Else
MsgBox Err.Source & &#; #&#; & Err & vbCrLf & vbCrLf & Err.Description, vbCritical
End If
Resume Exit_ExportToExcel
End Function


【access源码】一个用于将记录集数据导出到Excel的函数【Access软件网】

原文链接:,转发请注明来源!