MS Access VBA 导出查询结果

Posted 2023-04-19

【中文标题】MS Access VBA 导出查询结果

【英文标题】：MS Access VBA Export Query results

【发布时间】：2009-09-18 20:13:36

【问题描述】：

我需要帮助想出一种方法来允许用户在按钮单击事件上将查询结果导出到 xls 文件。 我尝试使用 Output To 宏，但它不适用于包含 30,000 多条记录的查询。

提前致谢

【问题讨论】：

你能发布你的代码吗？ （在我的回答中，您表示您尝试了 docmd。）

Excel 的目标版本是什么？对行数的限制无疑是 Excel 限制，而不是 Access 限制。 Excel 2007 增加了行数，顺便说一句。

实际上，Tony，我认为 Access 2002 标记在这里是有用的信息，因为它限制了导出格式。当然，我认为应该使用标签的方式是应该只使用 MS-ACCESS 并且问题中指出了具体版本，但是您删除了标签但没有将版本添加到问题文本中。在我看来，这会丢失有用的信息。

【参考方案1】：

您可能需要考虑使用自动化来创建 Excel 电子表格并自行填充，而不是使用宏。

这是我过去使用的一个函数。

Public Function ExportToExcel(FileToCreate As String, ByRef rst As ADODB.Recordset)
'Parms:     FileToCreate - Full path and file name to Excel spreadsheet to create
'           rst - Populated ADO recordset to export

On Error GoTo Err_Handler

Dim objExcel As Object
Dim objBook As Object
Dim objSheet As Object

'Create a new excel workbook; use late binding to prevent issues with different versions of Excel being
'installed on dev machine vs user machine
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add

'Hide the workbook temporarily from the user
objExcel.Visible = False

objBook.SaveAs (FileToCreate)

'Remove Worksheets so we're left with just one in the Workbook for starters
Do Until objBook.Worksheets.Count = 1
   Set objSheet = objBook.Worksheets(objBook.Worksheets.Count - 1)
   objSheet.Delete
Loop

Set objSheet = objBook.Worksheets(1)

rst.MoveFirst

'Use CopyFromRecordset method as this is faster than writing data one row at a time
objSheet.Range("A1").CopyFromRecordset rst

'The UsedRange.Rows.Count property can be used to identify the last row of actual data in the spreadsheet
'This is sometimes useful if you need to add a summary row or otherwise manipulate the data
'Dim lngUsedRange As Long
'lngUsedRange = objSheet.UsedRange.Rows.Count

'Save the spreadsheet
objBook.Save

objExcel.Visible = True

ExportToExcel = True

Err_Handler:
   Set objSheet = Nothing
   Set objBook = Nothing
   Set objExcel = Nothing
   DoCmd.Hourglass False

   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, Err.Description
   End If
End Function

【讨论】：

这段代码对我很有效，但唯一的问题是excel数据没有标题..我该如何添加它？

【参考方案2】：

你会使用 VBA 吗？

Intellisense 会帮助您，但请开始：

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_name", "C:\myfilename.xls"

注意：您可能有不同的 Excel 版本 “my_query_name”是您的查询或表的名称 您需要将文件位置设置为适当的 location\name .extension

更多信息：http://msdn.microsoft.com/en-us/library/bb214134.aspx

【讨论】：

我已经尝试过了，但我不断收到该位置错误中不存在的文件。