Access + VBA + SQL - 如何将多个查询导出到一个 Excel 工作簿中，但是，多个工作表使用表中的条件

Question

我需要一些帮助来将多个查询导出到一个 Excel 工作簿中，但是，多个工作表？ 使用 MS Access VBA 表中的条件

附件是数据库供参考。

表名：Tbl_Final（列在下面）

• 系统
• 用户身份
• 用户类型
• 地位
• 工作职位

根据表“Tbl_Final”（下面的 SQL 查询）中“系统”列中的唯一值，我需要创建 INDIVIDUAL excel 文件并将其导出到文件夹。 示例：SELECT TBL_FINAL.System, TBL_FINAL.[User ID], TBL_FINAL.[User Type], TBL_FINAL.Status, TBL_FINAL.[Job Position] FROM TBL_FINAL WHERE (((TBL_FINAL.System)="OS/400"));

    SELECT TBL_FINAL.System, TBL_FINAL.[User ID], TBL_FINAL.[User Type], TBL_FINAL.Status, TBL_FINAL.[Job Position]
    FROM TBL_FINAL
    WHERE (((TBL_FINAL.System)="Tab"));

谷歌搜索后，我设法找到了一个符合标准的代码。 但遇到一些障碍:(

请求一些帮助！

Option Compare Database

Private Sub Command1_Click()

    Dim strSQL As String
    Dim dbs As Database
    Dim qdf As QueryDef
    strQry = "REPORT_QUERY"

    Set dbs = CurrentDb
    Set qdf = dbs.CreateQueryDef(strQry)

    strSQL = "SELECT System, [User ID], [User Type], [Status] FROM TBL_FINAL WHERE System = 'OS/400'"
    qdf.SQL = strSQL
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel11, _
        strQry, "C:\Program Files\Export\GENERAL_EXPORT.xls", True, _
        "Sheet1"
    
    strSQL = "SELECT System, [User ID], [User Type], [Status] FROM TBL_FINAL WHERE System = 'MySys'"
    qdf.SQL = strSQL
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel11, _
        strQry, "C:\Program Files\Export\GENERAL_EXPORT.xls", True, _
        "Sheet2"
    
    DoCmd.DeleteObject acQuery, strQry

End Sub

Answer 1

以下 VBA 代码适用于我，创建一个包含多个工作表（ mySheet1和mySheet2 ）的新 Excel 工作簿（ .xlsx文件）：

Option Compare Database
Option Explicit

Sub ExportToXlsx()
    Dim cdb As DAO.Database, qdf As DAO.QueryDef
    Set cdb = CurrentDb

    Const xlsxPath = "C:\Users\Gord\Desktop\foo.xlsx"

    ' create .xlsx file if it doesn't already exist, and add the first worksheet
    Set qdf = cdb.CreateQueryDef("mySheet1", _
            "SELECT * FROM Clients WHERE ID Between 1 And 5")
    Set qdf = Nothing
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "mySheet1", xlsxPath, True
    DoCmd.DeleteObject acQuery, "mySheet1"

    ' file exists now, so this will add a second worksheet to the file
    Set qdf = cdb.CreateQueryDef("mySheet2", _
            "SELECT * FROM Clients WHERE ID Between 6 And 10")
    Set qdf = Nothing
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "mySheet2", xlsxPath, True
    DoCmd.DeleteObject acQuery, "mySheet2"

    Set cdb = Nothing
End Sub

请注意，工作表的名称取自要导出的查询（或表）的名称。 如果 Excel 文件中不存在具有该名称的工作表，则将添加该工作表。