<% Option Explicit Class ExcelGen Private objSpreadsheet Private iColOffset Private iRowOffset Private strTmpDir Sub Class_Initialize() Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet") iRowOffset = 2 iColOffset = 2 strTmpDir = "C:\Inetpub\wwwroot\spreadsheets\" End Sub Sub Class_Terminate() Set objSpreadsheet = Nothing 'Clean up 'Remove out of date spreadsheets CleanUpSpreadsheets End Sub Public Property Let ColumnOffset(iColOff) If iColOff > 0 then iColOffset = iColOff Else iColOffset = 2 End If End Property Public Property Let RowOffset(iRowOff) If iRowOff > 0 then iRowOffset = iRowOff Else iRowOffset = 2 End If End Property Sub GenerateWorksheetFromRecordset(objRS, bolAutofitColumns) 'Populates the Excel worksheet based on a Recordset's contents 'Start by displaying the titles If objRS.EOF then Exit Sub Dim objField, iCol, iRow, iMaxColVal iCol = iColOffset iRow = iRowOffset For Each objField in objRS.Fields objSpreadsheet.Cells(iRow, iCol).Value = objField.Name objSpreadsheet.Cells(iRow, iCol).Font.Bold = True objSpreadsheet.Cells(iRow, iCol).Font.Underline = True iCol = iCol + 1 Next 'objField iMaxColVal = iCol - 1 'Display all of the data Do While Not objRS.EOF iRow = iRow + 1 iCol = iColOffset For Each objField in objRS.Fields If IsNull(objField.Value) then objSpreadsheet.Cells(iRow, iCol).Value = "" Else objSpreadsheet.Cells(iRow, iCol).Value = objField.Value End If iCol = iCol + 1 Next 'objField objRS.MoveNext Loop If bolAutofitColumns then 'autofit columns For iCol = iColOffset to iMaxColVal objSpreadsheet.Columns(iCol).AutoFitColumns Next End If End Sub Function SaveWorksheet(strFileName) 'Save the worksheet to a specified filename On Error Resume Next Call objSpreadsheet.ActiveSheet.Export(strFileName, 0) SaveWorksheet = (Err.Number = 0) End Function Sub StreamWorksheet() 'Save the worksheet in a temporary file Dim strFileName, objFSO Set objFSO = Server.CreateObject("Scripting.FileSystemObject") strFileName = strTmpDir & objFSO.GetBaseName(objFSO.GetTempName) & ".xls" Set objFSO = Nothing if SaveWorksheet(strFileName) then Response.Redirect strFileName end if End Sub Private Sub CleanUpSpreadsheets() Dim objFS Dim objFolder Dim objFile set objFS = Server.CreateObject("Scripting.FileSystemObject") set objFolder = objFS.GetFolder(strTmpDir) 'Loop through each file in the strTmpDir folder for each objFile in objFolder.Files 'Delete Spreadsheets older than 10 minutes If DateDiff("n", objFile.DateLastModified, now) > 10 then objFS.DeleteFile strTmpDir & objFile.Name, True end if next set objFolder = nothing set objFS = nothing End Sub End Class %>