I'm exploring the wonderful world of generating an excel file from Access. I believe this is based on code I found here (wish i could give credit where due), and it works slick.

Here's what I'm trying to do. Sending variables from an input form, run the SQL queries twice, once for current data and once for last year's comparison and put each set of values into the appropriate part of each spreadsheet.

Everything is working correctly, except the second round of values (last year's data) is still from the current year.

The variables that have the date/term criteria are being revised, just not the underlying SQL string.

Any thoughts on how to refresh the SQL statements without repeating? Maybe a separate method that calls that sets the SQL string? I would test a few ideas I have, but there's a tight deadline and I was hoping someone might be able to push me further down the learning curve.

Thanks (Here's the function).
Public Sub ExportEnrollment(s As String, s2 As String, t As Date, t2 As Date)

On Error GoTo Err_ExportEnrollment

Dim objXL As Excel.Application

Dim xlWB As Excel.Workbook

Dim xlWS As Excel.Worksheet

Dim db As DAO.Database

Dim rst As DAO.Recordset

Set db = CurrentDb

Dim reportDate As String
Dim reportLast As String

reportDate = Month(Date) & "-" & Day(Date) & "-" & Year(Date)
reportLast = Month(Date) & "-" & Day(Date) - 1 & "-" & Year(Date)

Dim currYRTR As String
Dim currDate As Date

currYRTR = s
currDate = t

Dim sqlDiv As String
Dim sqlEnroll As String
Dim sqlCredits As String
Dim sqlTotal As String

'Division Enrollment Query
sqlDiv = "select t.DIV, count(t.TECH_ID) as Headcount, sum(t.CRDTS) as totalCRDTS," & _
" sum(t.CRDTS)/15 as FTE, sum(t.CRDTS)/30 as FYE" & _
" from" & _
" (SELECT TECH_ID, iif(C_COU.LVL Like 'D*','Developmental', iif(DIVISION_CODE='0001'," & _
" 'Liberal Arts', 'CTE')) AS DIV, Sum(S_COU.CRDTS) AS CRDTS" & _
" FROM (C_COU INNER JOIN S_COU ON (C_COU.TERM = S_COU.TERM) AND" & _
" (C_COU.COU_ID = S_COU.COU_ID)) LEFT JOIN C_DIVISION ON (C_COU.COU_ID = C_DIVISION.COU_ID) AND" & _
" (C_COU.TERM = C_DIVISION.TERM)" & _
" WHERE S_COU.TERM='" & currTERM & "' AND (S_COU.DROP_TIME_STAMP Is Null Or S_COU.DROP_TIME_STAMP>" & _
" #" & currDate & "#) AND C_COU.FTE_PCT>0 AND S_COU.CRDTS>0 AND C_COU.SUBJ<>'CCCC' And" & _
" C_COU.SUBJ Not Like 'CE*' And C_COU.SUBJ Not Like 'CT*' AND S_COU.ADD_TIME_STAMP<#" & currDate & "#" & _
" GROUP BY S_COU.TECH_ID, IIf(C_COU.LVL Like 'D*','Developmental', iif(DIVISION_CODE='0001'," & _
" 'Liberal Arts', 'CTE')), S_COU.TERM) as t" & _
" group by t.DIV" & _
" order by count(t.TECH_ID) DESC"

'First Time/Returning Query
sqlEnroll = "select t.status, count(t.TECH_ID) as Headcount, sum(t.CRDTS) as TotalCRHR," & _
" sum(t.CRDTS)/15 as FTE, sum(t.CRDTS)/30 as FYE" & _
" FROM (select sub.TERM, sub.TECH_ID, sum(sub.CRDTS) as CRDTS," & _
" IIf(sub.[ORIG_ENR_TERM]=sub.[TERM] or sub.ORIG_ENR_TERM Is Null,'First-Time','Returning')" & _
" as status FROM (SELECT S_COU.TERM, S_COU.TECH_ID, sum(S_COU.CRDTS) as CRDTS," & _
" Max(S_TERM_DATA.ORIG_ENR_TERM) AS ORIG_ENR_TERM FROM (S_TERM_DATA RIGHT JOIN S_COU" & _
" ON (S_TERM_DATA.TERM = S_COU.TERM) AND (S_TERM_DATA.TECH_ID = S_COU.TECH_ID))" & _
" INNER JOIN C_COU ON (S_COU.COU_ID = C_COU.COU_ID) AND (S_COU.TERM = C_COU.TERM)" & _
" WHERE S_COU.TERM= '" & currTERM & "' AND (DROP_TIME_STAMP Is Null Or" & _
" DROP_TIME_STAMP>#" & currDate & "#) AND FTE_PCT>0 AND CRDTS>0 AND SUBJ<>'CCCC' And" & _
" SUBJ Not Like 'CE*' And SUBJ Not Like 'CT*' AND S_COU.ADD_TIME_STAMP<#" & currDate & "#" & _
" GROUP BY S_COU.TERM, S_COU.TECH_ID) as sub group by sub.TECH_ID," & _
" IIf(sub.[ORIG_ENR_TERM]=[S_COU].[TERM] or sub.ORIG_ENR_TERM Is Null," & _
" 'First-Time','Returning'), sub.TERM) as t group by t.status"


'FullTime/PartTime query
sqlCredits = "select t.status, count(t.TECH_ID) as Headcount, sum(t.CRDTS) as CRHR," & _
" sum(t.CRDTS)/15 as FTE, sum(t.CRDTS)/30 as FYE" & _
" from" & _
" (select sub.TECH_ID, sub.CRDTS, iif(CRDTS<12, 'PT', 'FT') as status" & _
" from" & _
" (SELECT TECH_ID, Sum(S_COU.CRDTS) AS CRDTS, S_COU.TERM" & _
" FROM C_COU INNER JOIN S_COU ON (C_COU.COU_ID = S_COU.COU_ID) AND (C_COU.TERM = S_COU.TERM)" & _
" WHERE S_COU.TERM='" & currTERM & "' AND (DROP_TIME_STAMP Is Null Or DROP_TIME_STAMP>#" & currDate & "#) AND" & _
" FTE_PCT>0 AND CRDTS>0 AND SUBJ<>'CCCC' And SUBJ Not Like 'CE*' And SUBJ Not Like 'CT*' AND" & _
" S_COU.ADD_TIME_STAMP<#" & currDate & "#" & _
" GROUP BY S_COU.TECH_ID, S_COU.TERM) as sub) as t" & _
" group by t.status"

'Totals query
sqlTotal = "select 'Totals' as Total, count(t.TECH_ID) as Headcount, sum(t.CRDTS) as TotalCRHR," & _
" sum(t.CRDTS)/15 as FTE, sum(t.CRDTS)/30 as FYE" & _
" from" & _
" (select sub.TECH_ID, sum(sub.CRDTS) as CRDTS" & _
" from" & _
" (SELECT TECH_ID, Sum(S_COU.CRDTS) AS CRDTS, S_COU.TERM" & _
" FROM C_COU INNER JOIN S_COU ON (C_COU.COU_ID = S_COU.COU_ID) AND (C_COU.TERM = S_COU.TERM)" & _
" WHERE S_COU.TERM='" & currTERM & "' AND (DROP_TIME_STAMP Is Null Or DROP_TIME_STAMP" & _
" >#" & currDate & "#) AND FTE_PCT>0 AND CRDTS>0 AND SUBJ<>'CCCC' And SUBJ Not Like 'CE*' And" & _
" SUBJ Not Like 'CT*' AND S_COU.ADD_TIME_STAMP<#" & currDate & "#" & _
" GROUP BY S_COU.TECH_ID, S_COU.TERM) as sub" & _
" group by sub.TECH_ID) as t"

' opens the recordset


' instantiates the Excel objects

Set objXL = New Excel.Application

' makes the Excel application visible

objXL.Visible = True

' You have to add a work book to the app but you can open an existing one if your prefer

Set xlWB = objXL.Workbooks.Open("C:\EnrollmentReport" & reportLast & ".xls")

Set xlWS = objXL.Worksheets(1)

With xlWB

' put your path or variable to your path here

.SaveAs "C:\EnrollmentReport" & reportDate & ".xls"

' copies the recordset into the Excel Workbook

Set rst = db.OpenRecordset(sqlEnroll)
.Worksheets(1).Range("A3").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlCredits)
.Worksheets(1).Range("A6").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlDiv)
.Worksheets(1).Range("A9").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlTotal)
.Worksheets(1).Range("A13").CopyFromRecordset rst
.Save

currTERM = s2
currDate = t2
sqlEnroll = sqlEnroll
sqlCredits = sqlCredits

Set rst = db.OpenRecordset(sqlEnroll)
.Worksheets(1).Range("G3").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlCredits)
.Worksheets(1).Range("G6").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlDiv)
.Worksheets(1).Range("G9").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlTotal)
.Worksheets(1).Range("G13").CopyFromRecordset rst
.Save



End With

' garbage collection to free up memory

rst.Close

Set rst = Nothing

Set db = Nothing


Exit_ExportEnrollment:
Exit Sub
Err_ExportEnrollment:
MsgBox Err.Number & Err.Description
Resume Exit_ExportEnrollment

End Sub

Create functions that return the SQL string, and pass the variables to those functions.



Edited by: djsteele on Fri Nov 30 14:25:45 EST 2007.

Doug,

Thank you for the reply. It really saved me a lot of time.

Just in case someone cares, here's the end result...

Any improvements?

Public Sub ExportEnrollment(s As String, s2 As String, t As Date, t2 As Date)

On Error GoTo Err_ExportEnrollment

Dim objXL As Excel.Application

Dim xlWB As Excel.Workbook

Dim xlWS As Excel.Worksheet

Dim db As DAO.Database

Dim rst As DAO.Recordset

Set db = CurrentDb

Dim reportDate As String
Dim reportLast As String

reportDate = Month(Date) & "-" & Day(Date) & "-" & Year(Date)
reportLast = Month(Date) & "-" & Day(Date) - 1 & "-" & Year(Date)


' REVISION: Unneeded variables removed


' instantiates the Excel objects

Set objXL = New Excel.Application

' makes the Excel application visible

objXL.Visible = True

' You have to add a work book to the app but you can open an existing one if your prefer

Set xlWB = objXL.Workbooks.Open("C:\EnrollmentReport" & reportLast & ".xls")

Set xlWS = objXL.Worksheets(1)

With xlWB

' put your path or variable to your path here

.SaveAs "C:\EnrollmentReport" & reportDate & ".xls"

' copies the recordset into the Excel Workbook
'call functions with appropriate parameters
Set rst = db.OpenRecordset(sqlEnroll (s,t))
.Worksheets(1).Range("A3").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlCredits(s,t))
.Worksheets(1).Range("A6").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlDiv(s,t))
.Worksheets(1).Range("A9").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlTotal(s,t))
.Worksheets(1).Range("A13").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlEnroll(s2, t2))
.Worksheets(1).Range("G3").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlCredits(s2, t2))
.Worksheets(1).Range("G6").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlDiv(s2, t2))
.Worksheets(1).Range("G9").CopyFromRecordset rst
.Save

Set rst = db.OpenRecordset(sqlTotal(s2, t2))
.Worksheets(1).Range("G13").CopyFromRecordset rst
.Save



End With

' garbage collection to free up memory

rst.Close

Set rst = Nothing

Set db = Nothing


Exit_ExportEnrollment:
Exit Sub
Err_ExportEnrollment:
MsgBox Err.Number & Err.Description
Resume Exit_ExportEnrollment

End Sub


And here's the function...

Public Function sqlTotal(s As String, d As Date) As String

sqlTotal = "select 'Totals' as Total, count(t.TECH_ID) as Headcount, sum(t.CRDTS) as TotalCRHR," & _
" sum(t.CRDTS)/15 as FTE, sum(t.CRDTS)/30 as FYE" & _
" from" & _
" (select sub.TECH_ID, sum(sub.CRDTS) as CRDTS" & _
" from" & _
" (SELECT TECH_ID, Sum(S_COU.CRDTS) AS CRDTS, S_COU.TERM" & _
" FROM C_COU INNER JOIN S_COU ON (C_COU.COU_ID = S_COU.COU_ID) AND (C_COU.TERM = S_COU.TERM)" & _
" WHERE S_COU.TERM='" & currTERM & "' AND (DROP_TIME_STAMP Is Null Or DROP_TIME_STAMP" & _
" >#" & currDate & "#) AND FTE_PCT>0 AND CRDTS>0 AND SUBJ<>'CCCC' And SUBJ Not Like 'CE*' And" & _
" SUBJ Not Like 'CT*' AND S_COU.ADD_TIME_STAMP<#" & currDate & "#" & _
" GROUP BY S_COU.TECH_ID, S_COU.TERM) as sub" & _
" group by sub.TECH_ID) as t"

End Function