Ms access 使用DoCmd.OutputTo将Access查询导出到多个Excel文件

我有一个查询myQuery，它返回65000多条记录，因此无法导出到一个.xlsx文件

我正在尝试将此输出分解为多个文件

我仍然是VBA的初学者，但我已经尽我所能从研究中总结了以下内容。此代码旨在遍历查询的数据，然后为每个65000条记录输出一个新文件

专用子BTNFRM1导出\单击 Dim outputFileName作为字符串 Dim dlgOpen As FILE对话框 将numFiles设置为整数 以字符串形式调暗rs 作为整数的Dim numr 将sql设置为字符串 Dim rec As记录集 '允许用户选择文件的目标，并为sItem提供值。 设置dlgOpen=Application.FileDialogmsoFileDialogFolderPicker 用德尔戈潘 .Title=选择一个文件夹 .AllowMultiSelect=False 如果.Show-1那么 sItem=.SelectedItems1 如果结束 以 '对myQuery中的记录进行计数，以给出numFiles所需的文件数，假设每个文件有60000条记录。 Set rec=CurrentDb.OpenRecordsetmyQuery numFiles=Roundrec.RecordCount/60000，0 numr=1 '将当前数据库中查询的SQL更改为从myQuery中选择60000条记录 rs=从myQuery中选择前60000个myQuery.*项 CurrentDb.querydfs_vba.sql=rs '定义用于清除以下循环中使用的top 60000的SQL。 sql=从myQuery中删除前60000个myQuery。* '循环一次以创建所需的每个文件 当numFiles>0时执行此操作 '根据目标文件夹、文件编号numr和来自表单frm1上combobutton cbo1的信息设置文件名。 outputFileName=sItem&\&Forms！frm1！cbo1和报告Pt和numr和FormatDate，yyyyMMdd和.xlsx '将myQuery记录的前60000条输出到excel文件。 DoCmd.OutputTo acOutputQuery，_vba，acFormatXLSX，outputFileName numFiles=numFiles-1 numr=numr+1 '从myQuery中删除前60000名。 CurrentDb.executesql 环 端接头 然而，我得到：

运行时错误“2302”：Microsoft Access无法将输出数据保存到您选择的文件中

在DoCmd.OutputTo acOutputQuery中，_vba，acFormatXLSX，outputFileName

我确实需要在vba中实现自动化，无需弹出窗口等。任何使我的代码更高效、更恰当的建议都值得赞赏，但真正的问题是如何消除DoCmd.OutputTo的错误或使其正常工作

---

谢谢你的帮助

尽管主题行涉及尝试输出多个Excel文件，但真正的问题是尝试使用VBA从包含65000行以上的Access表或查询创建Excel文件。如果不需要VBA，则可以通过右键单击对象名称，选择“导出”，然后选择“Excel”来导出查询或表。不要勾选“导出带格式的数据…”复选框，它将起作用

下面显示的代码位于：由Christos Samaras创建，将正确地将大型表/查询导出到Excel

Option Compare Database
Option Explicit

Sub Test()  
    'Change the names according to your own needs.
    DataToExcel "Sample_Table", "Optional Workbook Path", "Optional Target Sheet Name"

    'Just showing that the operation finished.
    MsgBox "Data export finished successfully!", vbInformation, "Done"    
End Sub 


Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional     strTargetSheetName As String)

'Use this function to export a large table/query from your database to a new Excel workbook.
'You can also specify the name of the worksheet target.

'strSourceName is the name of the table/query you want to export to Excel.
'strWorkbookPath is the path of the workbook you want to export the data.
'strTargetSheetName is the desired name of the target sheet.

'By Christos Samaras
'http://www.myengineeringworld.net

Dim rst         As DAO.Recordset
Dim excelApp    As Object
Dim Wbk         As Object
Dim sht         As Object
Dim fldHeadings As DAO.Field

'Set the desired recordset (table/query).
Set rst = CurrentDb.OpenRecordset(strSourceName)

'Create a new Excel instance.
Set excelApp = CreateObject("Excel.Application")

On Error Resume Next

'Try to open the specified workbook. If there is no workbook specified
'(or if it cannot be opened) create a new one and rename the target sheet.
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
    Set Wbk = excelApp.Workbooks.Add
    Set sht = Wbk.Worksheets("Sheet1")
    If Len(strTargetSheetName) > 0 Then
        sht.Name = Left(strTargetSheetName, 34)
    End If
End If

'If the specified workbook has been opened correctly, then in order to avoid
'problems with other sheets that might contain, a new sheet is added and is
'being renamed according to the strTargetSheetName.
Set sht = Wbk.Worksheets.Add
If Len(strTargetSheetName) > 0 Then
    sht.Name = Left(strTargetSheetName, 34)
End If

On Error GoTo 0

excelApp.Visible = True

On Error GoTo Errorhandler

'Write the headings in the target sheet.
For Each fldHeadings In rst.Fields
    excelApp.ActiveCell = fldHeadings.Name
    excelApp.ActiveCell.Offset(0, 1).Select
Next

'Copy the data in the target sheet.
rst.MoveFirst
sht.Range("A2").CopyFromRecordset rst
sht.Range("1:1").Select

'Format the headings of the target sheet.
excelApp.Selection.Font.Bold = True
With excelApp.Selection
    .HorizontalAlignment = -4108 '= xlCenter in Excel.
    .VerticalAlignment = -4108  '= xlCenter in Excel.
    .WrapText = False
    With .Font
        .Name = "Arial"
        .Size = 11
    End With
End With

'Adjusting the columns width.
excelApp.ActiveSheet.Cells.EntireColumn.AutoFit

'Freeze the first row - headings.
With excelApp.ActiveWindow
    .FreezePanes = False
    .ScrollRow = 1
    .ScrollColumn = 1
End With
sht.Rows("2:2").Select
excelApp.ActiveWindow.FreezePanes = True

'Change the tab color of the target sheet.
With sht
    .Tab.Color = RGB(255, 0, 0)
    .Range("A1").Select
End With

'Close the recordset.
rst.Close
Set rst = Nothing

Exit Function

Errorhandler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function

End Function

---

由于您使用的是DAO，我很好奇“rec.RecordCount”的值是多少？除非您最后移动，否则通常不会填充该值？从Excel 2007 xlsx，行限制增加到1048576您有哪个访问版本？我很确定，从2010年起的版本，你可以绕过这个限制。@WayneG.Dunn，令人惊讶的是，我没有移动最后一个就得到了正确的结果。我插入了一行MsgBox以打印rec.RecordCount。不过，我没有足够的经验来解释。@kiks73我有Access 2010。在我尝试循环多个文件之前，我遇到的错误是Access无法复制超过65000条记录，因此据我有限的了解，这是剪贴板/内存限制。使用DoCmd.TransferSpreadsheet怎么样？