CODEWITHSUNDEEP
vbams-access
Basil
Basil

Reputation: 1004

Access VBA loop to export Excel files

I have some code that I copied and modified from Export Query in VBA loop to select data based on String Value

The code works although the problem is that when it runs it creates a query in the database which is then deleted at the end. If the code breaks half way through, this query is still in the database. So when the code is run again it gives an error message saying it can't create the query as it already exists.

The query that is created within the database is named "Select * from SalesData"

The objective is that I have a query called "SalesData" which includes sales information for a number of countries. I want to export all the data for each country into an Excel file in a loop without creating any additional Access objects. Is it possible to just filter the existing query within the VBA without creating the temporary object?

Can anyone suggest any modifications to the below code to achieve this?

Sub TEST()
Dim db As DAO.Database
Set db = CurrentDb()

Dim rs1 As DAO.Recordset
Set rs1 = db.OpenRecordset("Select Distinct Country From SalesData")

Dim v As String
Dim strQry As String
Dim qdfTemp As DAO.QueryDef
Dim strQDF As String

strQDF = "select * from SalesData"

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

    strQry = "SELECT * FROM SalesData WHERE Country = '" & v & "'"

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

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

    CurrentDb.QueryDefs.Delete strQDF
    rs1.MoveNext
Loop

rs1.Close

 End Sub

Upvotes: 0

Views: 753

Answers (2)

Basil
Basil

Reputation: 1004

Thanks to the input here, it seems that the only way to do it is to manipulate an existing query in the database or to create a query in the VBA script and then delete it at the end.

See below for an example of the first approach, the code uses a query already in the database called "blankquery".

Sub TEST()
Dim db As DAO.Database
Set db = CurrentDb()

Dim rs1 As DAO.Recordset
Set rs1 = db.OpenRecordset("Select Distinct Country From SalesData")

Dim qdfTemp As DAO.QueryDef
Dim v As String
Dim strQry As String
Dim strQDF As String

strQDF = "blankquery"

Do While Not rs1.EOF
v = rs1.Fields(0).Value
strQry = "SELECT * FROM SalesData WHERE Country = '" & v & "'"
db.QueryDefs(strQDF).sql = strQry
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
strQDF, "C:\Users\me\Desktop\VBA_TEST\" & v & ".xlsx", True
rs1.MoveNext
Loop

rs1.Close

End Sub

Upvotes: 0

Lee Mac
Lee Mac

Reputation: 16015

As far as I'm aware, it would not be possible to use the TransferSpreadsheet method to extract a parameterised version of your SalesData query without either modifying the SQL of the SalesData query itself or using an additional query with selection criteria applied to the data returned by SalesData.

However, you needn't delete & recreate such query with every iteration of the loop - instead, simply modify the SQL property of the query, e.g.:

Sub test()
    Dim qry As String: qry = "salesdata_temp"
    Dim sql As String: sql = "select * from salesdata where country = '{0}'"
    Dim out As String: out = "C:\Users\me\Desktop\VBA_TEST\"
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef

    On Error Resume Next
    DoCmd.DeleteObject acQuery, qry
    On Error GoTo error_handler

    Set dbs = CurrentDb
    Set qdf = dbs.CreateQueryDef(qry, sql)

    With dbs.OpenRecordset("select distinct country from salesdata")
         If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                qdf.sql = Replace(sql, "{0}", !country)
                DoCmd.TransferSpreadsheet acExport, , qry, out & !country & ".xlsx", True
                .MoveNext
            Loop
         End If
         .Close
    End With

exit_sub:
    On Error Resume Next
    DoCmd.DeleteObject acQuery, qry
    Exit Sub

error_handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume exit_sub
End Sub

Upvotes: 1

Related Questions