将 Access 数据导出到 Excel 工作簿并根据列值将数据拆分为多个工作表

Export Access data into Excel workbook and split data into multiple sheets based on column value

示例数据(本地访问table调用'Pets_data_table')

ID | Pet_Type | Pet_Owner

1      Dog        Jane Doe         
2      Cat        John Doe
3      Hamster    Bob Doe
4      Dog        Melissa Doe 
5      Cat        Aaron Doe

目前,我可以将此table中的数据导出到一个Excel工作簿中,并根据不同的值将数据拆分到Excel工作簿中的多个工作表中一个特定的领域。我使用以下 VBA 根据 'Pet_Type' 字段的不同值拆分数据:

    Dim db As DAO.Database
    Set db = CurrentDb()
    Dim strPath As String
    strPath = "C:\Desktop\" & "Pets_dataset_export_" & format(date(),"yyyy-mm-dd") & ".xlsx" 
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Dog", strPath, True, "Dog"
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Cat", strPath, True, "Cat"
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Hamster", strPath, True, "Hamster"

    Set db = Nothing
    MsgBox "Export operation completed"

当我用来拆分数据的字段具有少量不同的值时,它表现良好。

但是,当我要拆分数据的字段中有大量不同的值时,效率很低。

我想实施一种更动态的方法,允许我使用具有 1...n 个不同值的字段拆分数据集。

根据为您提供独特宠物类型的查询加载单个记录集...

SELECT DISTINCT p.Pet_Type
FROM Pets_data_table AS p;

然后遍历该记录集,将保存的查询 (qryExportMe) 更改为 SELECT 当前 Pet_Type,然后导出查询 ...

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strPath As String
Dim strSelectOneType As String
Dim strSelectPetTypes As String

' (change strPath back to what you need)
strPath = CurrentProject.Path & Chr(92) & "Pets_dataset_export_" & _
    Format(Date, "yyyy-mm-dd") & ".xlsx"
strSelectPetTypes = "SELECT DISTINCT p.Pet_Type" & vbCrLf & _
    "FROM Pets_data_table AS p;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSelectPetTypes, dbOpenSnapshot)
Do While Not rs.EOF
    strSelectOneType = "SELECT p.ID, p.Pet_Type, p.Pet_Owner" & vbCrLf & _
        "FROM Pets_data_table AS p" & vbCrLf & _
        "WHERE p.Pet_Type='" & rs!Pet_Type.Value & "';"
    Debug.Print strSelectOneType
    Set qdf = db.QueryDefs("qryExportMe")
    qdf.SQL = strSelectOneType
    qdf.Close
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
        "qryExportMe", strPath, True, rs!Pet_Type.Value
    rs.MoveNext
Loop
rs.Close

请注意,代码要求保存的查询 qryExportMe 存在。但它的 SQL 属性 并不重要,因为每次通过主 Do While 循环都会更改它。