E
Erick C
Hello again.
I think that I may have finally tried to make something that may not
be possible. I want to create multiple excel spreadsheets for each
unique identifier (Subinventory) in one of my tables. I tried to
modify the code provided by Ken Snell on his very helpful website, but
I tried to get a bit too inventive.
I also tried to combine the code for browsing to a single folder to
export the data. So, essentially I was trying to create a button that
would open a dialog box where the user can select the correct folder
and then the individual spreadsheets are created in that folder.
I also had a bit of trouble matching up information for the code since
the example uses manager and associate names along with an ID number.
I do not have an actual name, I only have a number for a location. I
made a separate table with only the store numbers (Subinventories)
that are being exported. The other table has all of the data to be
exported.
I don't know if anybody has ever done anything like this, or if this
is even possible. Any help would be appreciated.
Here is my code. I also left the example information for reference
purposes.
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr 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 for
each 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
' Replace C:\FolderName\ with actual path
DoCmd.TranferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, strPathFile
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
I think that I may have finally tried to make something that may not
be possible. I want to create multiple excel spreadsheets for each
unique identifier (Subinventory) in one of my tables. I tried to
modify the code provided by Ken Snell on his very helpful website, but
I tried to get a bit too inventive.
I also tried to combine the code for browsing to a single folder to
export the data. So, essentially I was trying to create a button that
would open a dialog box where the user can select the correct folder
and then the individual spreadsheets are created in that folder.
I also had a bit of trouble matching up information for the code since
the example uses manager and associate names along with an ID number.
I do not have an actual name, I only have a number for a location. I
made a separate table with only the store numbers (Subinventories)
that are being exported. The other table has all of the data to be
exported.
I don't know if anybody has ever done anything like this, or if this
is even possible. Any help would be appreciated.
Here is my code. I also left the example information for reference
purposes.
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr 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 for
each 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
' Replace C:\FolderName\ with actual path
DoCmd.TranferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, strPathFile
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing