将多个访问查询资源保存到单个 Excel 工作簿中的单独工作表

Question

我有提取数据并为每个查询创建一个工作簿的查询。工作簿将写入本地驱动器。

我手动将每个选项卡/工作表添加到主工作簿。我想让我的代码创建这个主工作簿，每个查询结果都有一个工作表。

此代码创建 6 个单独的电子表格;

Function PROC_WithoutRACF()
On Error GoTo WithoutRACF_Err
    DoCmd.OutputTo acOutputQuery, "MyTable1", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "MyTable2", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "MyTable3", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "MyTable4", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "MyTable5", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint
    DoCmd.OutputTo acOutputQuery, "MyTable1", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, "", , acExportQualityPrint

WithoutRACF_Exit:
    Exit Function
WithoutRACF_Err:
    MsgBox Error$
    Resume WithoutRACF_Exit
End Function

此代码不起作用

Function Proc_WithoutRACF_MySpreadsheet()
On Error GoTo WithoutRACF_Err
    DoCmd.OutputTo acOutputQuery, "MyTable1", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable1"
    DoCmd.OutputTo acOutputQuery, "MyTable2", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable2"
    DoCmd.OutputTo acOutputQuery, "MyTable3", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable3"
    DoCmd.OutputTo acOutputQuery, "MyTable4", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable4"
    DoCmd.OutputTo acOutputQuery, "MyTable5", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable5"
    DoCmd.OutputTo acOutputQuery, "MyTable6", "Excel97-Excel2003Workbook(*.xls)", "MyFileLocation.xls", False, acExport, acSpreadsheetTypeExcel9, "MyTable6"
WithoutRACF_Exit:
    Exit Function
WithoutRACF_Err:
    MsgBox Error$
    Resume WithoutRACF_Exit
End Function

Answer 1

下面的示例创建一个包含 6 个工作表的新工作簿，并通过帮助程序方法使用 Excel 的 Range.CopyFromRecordset 方法将查询复制到每个工作表。

为简单起见，我假设查询具有连续的名称，即 MyTable1、MyTable2、MyTable3 等，如您的示例所示。如果不是这种情况，则必须进行修改。

Sub ExportToExcel()
    Dim rs As DAO.Recordset
    Dim objApp As Object, objBook As Object, objSheet As Object
    Dim idx As Long
    Set objApp = CreateObject("Excel.Application")
        objApp.Visible = True
    Set objBook = objApp.Workbooks.Add()
    For idx = 1 To 6
        With objBook
            Set rs = CurrentDb().QueryDefs("MyTable" & idx).OpenRecordset()
            'add sheet if needed
            If .Sheets.Count < idx Then .Sheets.Add After:=.Sheets(.Sheets.Count)
            Set objSheet = objBook.Worksheets(idx)
            'call helper
            CopyFromRecordsetWithHeader rs, objSheet
            rs.Close
        End With
    Next
End Sub
Private Sub CopyFromRecordsetWithHeader(rs As DAO.Recordset, objSheet As Object)
    Dim idx As Long
    'Create headers
    For idx = 0 To rs.Fields.Count - 1
        objSheet.Cells(1, idx + 1).Value = rs.Fields(idx).Name
    Next
    'Copy data
    With objSheet
        .Range(.Cells(1, 1), .Cells(1, rs.Fields.Count)).Font.Bold = True
        .Range("A2").CopyFromRecordset rs
    End With
End Sub