ACTEBS
actebs at actebs.com.au
Tue Jun 10 10:15:39 CDT 2003
Susan,
Try changing:
Dim db As Database
To:
Dim db As DAO.Database
HTH
Regards
Vlad
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
paul.hartland at fsmail.net
Sent: Tuesday, 10 June 2003 11:35 PM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] Help!Why won't this work?
Susan,
Does it give you any error messages ?
Paul
From: "Klos, Susan" <Susan.Klos at fldoe.org>
Date: Tue 10/Jun/2003 13:28 GMT
To: "'accessd at databaseadvisors.com'" <accessd at databaseadvisors.com>
Subject: [AccessD] Help!Why won't this work?
It worked yesterday.
'------------------------------------------------------------
' mcrSaveReading
'
'------------------------------------------------------------
Function mcrSaveReading()
On Error GoTo mcrSaveReading_Err
Dim school As String
Dim strFileName As String
Dim mysql As String
Dim qdf As QueryDef
Dim db As Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("GradedSchools")
Do Until (rs.EOF)
school = rs.Fields("DistSchNo")
'school = InputBox("What School Number")
'school = "[GradedSchools.DistSchNo]"
'MsgBox school
'DoCmd.TransferSpreadsheet acExport, 8, "Reading",
"T:\2002-2003\SchoolGrades\Data\Reading" & school & ".xls", True, ""
mysql = "SELECT ReadingGrade.DistSchNo, ReadingGrade.Grade,
ReadingGrade.LName, ReadingGrade.FName, " & _
"ReadingGrade.IDSS, ReadingGrade.Curr03, ReadingGrade.MatchFCAT02,
ReadingGrade.LevelR03, " & _
"ReadingGrade.LevelR02, ReadingGrade.DSS03R, ReadingGrade.DSSR02,
ReadingGrade.SSR02, ReadingGrade.Lo25 FROM ReadingGrade " & _
"WHERE (((ReadingGrade.DistSchNo)='" & school & "'))"
Set qdf = db.QueryDefs("Reading")
strFileName = "T:\2002-2003\SchoolGrades\Data\Reading" & school &
".xls"
qdf.SQL = mysql
'MsgBox "tablename = " & strFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
qdf.Name, strFileName, True
rs.MoveNext
Loop
mcrSaveReading_Exit:
Exit Function
mcrSaveReading_Err:
MsgBox Error$
Resume mcrSaveReading_Exit
End Function
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
________________________________________________________________________
__
Join Freeserve http://www.freeserve.com/time/
Winner of the 2003 Internet Service Providers' Association awards for
Best Unmetered ISP and Best Consumer Application.
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com