Export Query in VBA loop to select data based on S

问题:

I have a table called TEST, which I have code below that loops an export query based on unique values in the column Territory.

The code is supposed to export data to excel files based on the unique values in the column Territory. So each Territory value would have it's own file.

I am having trouble with setting up the sql query and how to use the string value to select the data:

Sub TEST()

    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim v As String

    Set db = CurrentDb()
    Set rs1 = db.OpenRecordset("Select Distinct Territory From TEST")

    Do While Not rs1.EOF
        v = rs1.Fields(0).Value

        **DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
        "WHAT SHOULD MY QUERY BE TO USE STRING v?", "C:\Users\me\Desktop\VBA_TEST\" v & ".xls", True**

        rs1.MoveNext
    Loop

    rs1.Close

End Sub

Can someone guide me into how I may write the query and connect the string v so that it loops out reports?

Thank you!

回答1:

I think you are required to use an existing query and not just your query as a string for the TransferSpreadsheet method. This means you will need a temporary query object to transfer your spreadsheet.

You can add a variable to query by joining it to the SQL string making sure that for text fields you include an ' on either side and leave it off for numeric fields.

Sub TEST()
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim v As String

    Set db = CurrentDb()
    Set rs1 = db.OpenRecordset("Select Distinct Territory From TEST")

    Dim strQry As String
    Dim qdfTemp As DAO.QueryDef
    Dim strQDF As String
    strQDF = "_TempQuery_"

    Do While Not rs1.EOF
        v = rs1.Fields(0).Value

        strQry = "SELECT * FROM TEST WHERE Territory = '" & v & "'"

        Set qdfTemp = CurrentDb.CreateQueryDef(strQDF, strQry)
        qdfTemp.Close
        Set qdfTemp = Nothing

        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
        strQDF, "C:\Users\me\Desktop\VBA_TEST\" & v & ".xls", True

        CurrentDb.QueryDefs.Delete strQDF
        rs1.MoveNext
    Loop

    rs1.Close

End Sub