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