Export multiple versions of a query to separate Excel files

[Erick C]

Ken -

That was the fix, it now works! You are the best!
I cannot thank you enough for all of your assistance. You have been
extremely helpful and patient and it is definitely appreciated. You
have officially made an entire department over here very happy!

Thanks again!

We'll get there. This line that you posted:

           strMgr = DLookup("Subinventory", "Stores for Export", _
                  "Subinventory = '" & rstMgr!Subinventory.Value &
"'")

should be this:

           strMgr = DLookup("Subinventory", "Stores for Export", _
                  "Subinventory = '" & rstMgr1!Subinventory.Value &
"'")

--

        Ken Snell
<MS ACCESS MVP>http://www.accessmvp.com/KDSnell/


Hi Ken -
I made the update from your last response.
When I tried to run I received a syntax error and the debugger went to
the rstMgr1.EOF portion.  The debugger highlighted the Do While
rstMgr1.EOF portion:

If rstMgr1.EOF = False And rstMgr1.BOF = False Then
      Do While rstMgr1.EOF = False Then

I looked at the code above this spot and saw that the previous "Do
While" did not have the Then at the end, so I removed this one and
tried to run again.
On the second one, I received a runtime error 3021 saying No Current
Record.
This time the debugger highlighted the Dlookup code directly below the
rstMgr1.EOF from above.

' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
           strMgr = DLookup("Subinventory", "Stores for Export", _
                  "Subinventory = '" & rstMgr!Subinventory.Value &
"'")

Sorry - copy/paste error on my part:

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset, rstMgr1 As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames As Boolean

strBrowseMsg = "Select the folder where the detail files will be created:"
strPath = BrowseFolder(strBrowseMsg)
If strPath = "" Then
MsgBox "No folder was selected.", vbOK, "No Selection"
Exit Sub
End If

Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and
Field names
' with the real names of the EmployeesTable table and the ManagerID
Field
strSQL = "SELECT DISTINCT Subinventory FROM [Subinv Subtotal By
Transaction
Type];"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query foreach
ManagerID
' so that the data can be exported -- the code assumes that the actual
names
' of the managers are in a lookup table -- again, replace generic names
with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("Subinventory", "Stores for Export", _
"Subinventory = '" & rstMgr!Subinventory.Value & "'")
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM [Subinv Subtotal By Transaction Type]
WHERE " & _
"Subinventory = '" & rstMgr!Subinventory.Value & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing

strFile = Format$(Date, "Medium Date") & " " & strMgr & ".xls"
strPathFile = strPath & "\" & strFile

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
strTemp, strPathFile

rstMgr.MoveNext
Loop
End If

' Get list of ManagerID values -- note: replace my generic table and
Field names
' with the real names of the EmployeesTable table and the ManagerID
Field
strSQL = "SELECT DISTINCT Subinventory FROM [CC Adj Totals];"
Set rstMgr1 = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
' Now loop through list of ManagerID values and create a query foreach
ManagerID
' so that the data can be exported -- the code assumes that the actual
names
' of the managers are in a lookup table -- again, replace generic names
with
' real names of tables and fields
If rstMgr1.EOF = False And rstMgr1.BOF = False Then
Do While rstMgr1.EOF = False Then
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("Subinventory", "Stores for Export", _
"Subinventory = '" & rstMgr!Subinventory.Value & "'")
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM [CC Adj Totals] WHERE " & _
"Subinventory = '" & rstMgr1!Subinventory.Value & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing

strFile = Format$(Date, "Medium Date") & " " & strMgr & ".xls"
strPathFile = strPath & "\" & strFile

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, strPathFile, , "CC Adj Totals"

Loop
End If
rstMgr.Close
rstMgr1.Close
Set rstMgr = Nothing
Set rstMgr1 = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

MsgBox "Individual Analysis Files Created.", vbOK, "Status"

Ken Snell
<MS ACCESS MVP>http://www.accessmvp.com/KDSnell/

"Erick C" <[email protected]> wrote in message

Ken -
Thank you for the update. As always, you are the greatest!
I have added the code that you modified and I am getting an error:
Compile Error: Loop Without Do
The debugger highlights the loop at the end, right before the
rstMgr.Close and rstMgr1.Close.
How can I get rid of this error?- Hide quoted text -

- Show quoted text -

 

[Ken Snell [MVP]]

Ken -

That was the fix, it now works! You are the best!
I cannot thank you enough for all of your assistance.
You have been
extremely helpful and patient and it is definitely appreciated.
You
have officially made an entire department over here very
happy!

You're welcome.