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张工作表的新工作簿，并通过帮助程序方法使用Range.CopyFromRecordset Excel方法将查询复制到每个工作表。

为简单起见，我假设查询具有顺序名称，即 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

将多个Access Query resuts保存到单个Excel工作簿中的单独工作表中

1 个答案: