B
Beth Eadie
I am trying to export a query out to an Excel spreadsheet with multiple tabs.
I found some code written by MVP Ken Snell and I was able to modify it to
work just about perfectly in my database, with one exception -- whenever I
run the code, I am getting "Enter Parameter Value" boxes. If I type in the
parameter, it works exactly as it should. But I don't want to user to have
to type that in (there will end up being about 20+ tabs in the spreadsheet,
so I don't want the user to type in that many school names).
I know the reasoning behind the "Enter Parameter Value" boxes, but I can't
find in the code where I need to make a change. I have debugged and gone
through the code line by line and I just can't fingure out where my error
lies. Any help would be much appreciated.
Thank you for your time!
Here is my VBA code:
Private Sub cmd_EntireDistrict_Click()
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
Const strFileName As String = "StudentIDs"
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
strSQL = "SELECT DISTINCT [Principals-BTCs].[School (SHORT)] FROM
qry_EntireDistrict;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
strMgr = DLookup("[Principals-BTCs].[School (SHORT)]",
"[Principals-BTCs]", "[School (SHORT)] = '" & rstMgr![School (SHORT)].Value &
"'")
strSQL = "SELECT * FROM qry_EntireDistrict WHERE " & "[School (SHORT)] = " &
strMgr & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\Documents and Settings\BEadie\Desktop\Student
ID DB\" & strFileName & ".xls"
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
I found some code written by MVP Ken Snell and I was able to modify it to
work just about perfectly in my database, with one exception -- whenever I
run the code, I am getting "Enter Parameter Value" boxes. If I type in the
parameter, it works exactly as it should. But I don't want to user to have
to type that in (there will end up being about 20+ tabs in the spreadsheet,
so I don't want the user to type in that many school names).
I know the reasoning behind the "Enter Parameter Value" boxes, but I can't
find in the code where I need to make a change. I have debugged and gone
through the code line by line and I just can't fingure out where my error
lies. Any help would be much appreciated.
Thank you for your time!
Here is my VBA code:
Private Sub cmd_EntireDistrict_Click()
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
Const strFileName As String = "StudentIDs"
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
strSQL = "SELECT DISTINCT [Principals-BTCs].[School (SHORT)] FROM
qry_EntireDistrict;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
strMgr = DLookup("[Principals-BTCs].[School (SHORT)]",
"[Principals-BTCs]", "[School (SHORT)] = '" & rstMgr![School (SHORT)].Value &
"'")
strSQL = "SELECT * FROM qry_EntireDistrict WHERE " & "[School (SHORT)] = " &
strMgr & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\Documents and Settings\BEadie\Desktop\Student
ID DB\" & strFileName & ".xls"
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing